Поиск сообщества

еще хороший тон прилагать хотя бы краткую инструкцию - что надо переименовать, куда поместить путь к базе, и что нажать, чтобы запустить программу и потом что нажать, чтобы получить ошибку. еще раз обращаю внимание, что для того, чтобы вам помогали, нужно как-то позаботиться о том, кто должен почему-то разбираться в вашем коде. Он не отформатирован даже. Есть волшебство Ctrl+D или Ctrl+W в cnWizard, которые это даже делают автоматически за вас. я двумя постами выше написал, как должен выглядеть запрос. У вас совершенно не такой. Если вы хотите делать по-своему, делайте, но я тогда при чем тут? самое главное. Даже неправильный запрос нужно открыть! FDQuery4.SQL.Clear; FDQuery4.SQL.Add('SELECT * FROM usersbase'); FDQuery4.SQL.Add('WHERE Login='+Login); Password1:=FDQuery1.FieldByName('Password').AsString; Group1:=FDQuery1.FieldByName('Group').AsString; Other1:=FDQuery1.FieldByName('Other').AsString; где тут открытие ? в какой момент программа должна обратиться к серверу? ну и ясно, что мой текст по ссылке вы не читали. потому что строковые константы хотя бы нужно оборачивать кавычками, но вообще речь шла о параметрах, которые позволяют и этого не делать. я не стал разбираться в хитростях остальной вашей логики, там сомнительное использование непонятно где объявленных внешних переменных и какие-то неизвестные науке операции с числами и строками из базы. еще совершенно неясно, почему запрос идет в FDQuery4, а поля вы запрашиваете в FDQuery1 ??? главная идея - вам юзер ввел логин и пароль. вы запросили сервер, есть ли юзер с таким логином и паролем. сервер либо нашел его, либо нет. если нет, то все переменные неплохо бы сбросить в пусто. сам запрос помещен в компонент в дизайн-тайме, не нужно его каждый раз писать заново итого function TForm4.verifikation(Login, Password: string): string; begin result := ''; Group1 := ''; Other1 := ''; FDQuery4.Close(); FDQuery4.ParamByName('login').AsString := login; FDQuery4.ParamByName('password').AsString := password; FDQuery4.Open(); if FDQuery4.RecordCount = 0 then exit; I := 4; Password1 := Password; Group1 := FDQuery4.FieldByName('Group').AsString; Other1 := FDQuery4.FieldByName('Other').AsString; if Group1 <> 'Admin' then I := I - 1 else Result := '"' + inttostr(I) + '"' + Other1 + '"'; if Group1 <> 'moder' then I := I - 1 else Result := '"' + inttostr(I) + '"' + Other1 + '"'; end;

Здравствуйте! Блоб параметры в процедурах PostgreSQL победить не удалось, а вот та же функциональность через Блоб-поля TFDQuery была достигнута. В целом такой вариант более универсален. void __fastcall TNNConfig::SaveToDB() { if ( Connection && !Connection->Connected ) return; TMemoryStream* ms = new TMemoryStream(); fFiler = new TNNTextStream( ms ); try { SaveFilerFromUserEvent(); std::unique_ptr< TFDQuery > quReg( new TFDQuery( this ) ); std::unique_ptr< TFDTransaction > trReg( new TFDTransaction( this ) ); quReg->Connection = Connection; trReg->Connection = Connection; quReg->Transaction = trReg.get(); String RK = RegistryKey(); Connection->StartTransaction(); try { quReg->SQL->Text = "SELECT \"UserRegKey\", \"UserData\" FROM \"UserReg\" where \"UserRegKey\" = :UserRegKey_"; quReg->Params->Items[ 0 ]->DataType = ftString; quReg->Params->Items[ 0 ]->AsString = RK; quReg->Open(); if ( quReg->RecordCount == 0 ) { quReg->Insert(); quReg->Fields->Fields[ 0 ]->AsString = RK; } else quReg->Edit(); TBlobField *bf = ((TBlobField *)(quReg->Fields->Fields[ 1 ])); bf->LoadFromStream( Filer ); quReg->Post(); Connection->Commit(); } catch ( ... ) { Connection->Rollback(); } } __finally { delete fFiler; fFiler = nullptr; } } bool __fastcall TNNConfig::LoadFromDB() { if ( Connection && !Connection->Connected ) return false; bool B = false; std::unique_ptr< TFDQuery > quReg( new TFDQuery( this ) ); std::unique_ptr< TFDTransaction > trReg( new TFDTransaction( this ) ); quReg->Connection = Connection; trReg->Connection = Connection; quReg->Transaction = trReg.get(); quReg->SQL->Text = "SELECT \"UserRegKey\", \"UserData\" FROM \"UserReg\" where \"UserRegKey\" = :UserRegKey_"; quReg->Params->Items[ 0 ]->DataType = ftString; quReg->Params->Items[ 0 ]->AsString = RegistryKey(); quReg->Open(); if ( quReg->RecordCount == 1 ) { TBlobField *bf = ((TBlobField *)(quReg->Fields->Fields[ 1 ])); bf->SaveToStream( Filer ); B = true; } return B; } Вопрос закрыт! Спасибо! С уважением, Навадвипа Чандра дас.

Спасибо за этот совет, мне он помог наконец-то успешно запустить мой android сервис, который сохряняет в БД sqlite некоторые данные из инета. Но есть другая проблема. Я запускаю свое мобильное приложение, нажимаю кнопочку и запускается фоновый сервис. Пока я нахожусь в главном приложении, сервис работает, я вижу как обновляются данные в таблицах. Все хорошо. Если закрыть приложение, то сервис работает в фоне - тоже все ок. Но если я попытають снова запустить приложение, пока сервис в фоне делает выборку или записывает данные в таблицу, то мое приложение не запускается - я вижу черный экран. Как только сервис закончил работать с таблицами и сделал небольшую паузу на 5 минут, в этот промежуток времени я могу окрыть свое приложение. Вывод такой: сервис блокирует мою базу данных пока с ней работает. Как сделать паралельный доступ к БД и из приложения и из сервиса? Сервис использует простую схему работы: fdquery1.SQL.Text := 'select * from table1' fdquery1.Open for i:= 0 to fdquery1.RecordCount -1 do begin // здесь я считываю поля таблицы(например, ссылки на сайты), затем лезу по каждому урлу на сайт и, если на нем появились новые данные, то сохраняю их в Table2. end; Я так понимаю, пока у меня fdquery1.Open, мое приложение не запустится, поскольку база заблокирована сервисом. Как это лечится? FDСonnection LockingMode = imNormal FDQuery cmdExecMode = amNonBlocking

Всем привет. Вообщем пытаюсь синхронизировать свою локальную базу с сервером, использую при этом Restrequest,все идет нормально но только приложение зависает на время цикла. В цикле идет перебор все данных в локальной базе и заносится по ссылке в базу. Пытался сделать в потоке но выскакивает ошибка "Argument errore", а без потока не выскакивает. Есть решение для улучшения скорости или хотя бы убрать зависания приложения? спасибо за ранее за вашу помощь. var aggiornarichiesta: TJSONObject; i,b: Integer; a:TStream; begin FDTable1.First; for i := 0 to FDTable1.RecordCount do begin if RESTRequest1.Response.StatusCode = 200 then begin try RESTRequest1.ClearBody; RESTClient1.BaseURL := 'http://localhost/loman/dati.php'; RESTRequest1.Execute; aggiornarichiesta := TJSONObject.Create; aggiornarichiesta.AddPair('id', FDTable1ID.Text); aggiornarichiesta.AddPair('Materiale', FDTable1.FieldByName('Materiale').AsString); aggiornarichiesta.AddPair('Descripzione', FDTable1.FieldByName('Descripzione').AsString); aggiornarichiesta.AddPair('Quantita', FDTable1.FieldByName('Quantita') .AsString); aggiornarichiesta.AddPair('Treno', FDTable1.FieldByName('Treno') .AsString); aggiornarichiesta.AddPair('Discorta', FDTable1.FieldByName('Discorta') .AsString); aggiornarichiesta.AddPair('Commento', FDTable1.FieldByName('Commento') .AsString); aggiornarichiesta.AddPair('Creatoda', FDTable1.FieldByName('Creatoda') .AsString); aggiornarichiesta.AddPair('Ordinato', FDTable1.FieldByName('Ordinato') .AsString); RESTClient1.BaseURL := 'http://localhost/loman/Product/update.php'; RESTRequest1.ClearBody; RESTRequest1.AddBody(aggiornarichiesta.ToString, ContentTypeFromString('application/json')); RESTRequest1.Execute; FDTable1.Next; RESTRequest1.ClearBody; RESTClient1.BaseURL := 'http://localhost/loman/dati.php'; RESTRequest1.Execute; finally RESTRequest1.DisposeOf; end; end; end;

Ознакомьтесь с FireDAC.Stan.Option.TFDFetchOptions.RecordCountMode. И начните уже пользоваться поиском на форуме... Не один раз обсуждалась эта тема Показаны результаты для 'RecordCount' p.s. Тему перенёс в подходящий раздел.

Подскажите пожалуйста почему когда я пытаюсь заполнить ComboBox из базы SQLite в мобильном приложении для Android вот так: //заполняем ComboBox двигателя FDQuery_ComboBox.Active:=False; FDQuery_ComboBox.SQL.Clear; FDQuery_ComboBox.SQL.Add('SELECT Dvig_ob FROM TabSR '); FDQuery_ComboBox.Active:=True; //ShowMessage('Количество строк: '+IntToStr(FDQuery_ComboBox.RecordCount)); for i:=1 to FDQuery_ComboBox.RecordCount do Begin FDQuery_ComboBox.RecNo := i; ComboBox_Engin.Items.Add(FDQuery_ComboBox.Fields[0].AsString); End; в FDQuery_ComboBox.RecordCount всего ровно 50 позиций хотя в таблице TabSR 288 строк???? СпасиБО. С Уважением.

СпасиБО SLAVZ. Попробую. Может Вам пригодится я вот так вышел и положения: Сначала: //выбираем фото из галереи устройства procedure TForm_haracteristik.TakePhotoFromLibraryAction1DidFinishTaking( Image: TBitmap); begin Image_ФотоХаракДвиг.Bitmap.Assign(Image); end; Потом вношу в Базу: //ввести харак-ку procedure TForm_haracteristik.Button_ВвестиClick(Sender: TObject); begin if Edit_НазваниеХарактеристики.Text='' then begin ShowMessage('Вы не ввели название характеристики.'); Abort; end; //проверяем наличие дубля названия характеристики: FDQuery_Engin.Open; FDQuery_Engin.SQL.Clear; FDQuery_Engin.SQL.Add('select * from Tab_Harak_Engin where Name_Harak = ' + #39+ Edit_НазваниеХарактеристики.Text +#39); FDQuery_Engin.Active:=True; if FDQuery_Engin.RecordCount > 0 then begin ShowMessage('Такое название уже есть !'); Abort; end else begin Try FDQuery_Engin.Active:=False; FDQuery_Engin.SQL.Clear; FDQuery_Engin.SQL.Add('SELECT * FROM Tab_Harak_Engin ORDER BY Name_Harak' ); FDQuery_Engin.Active:=True; //вставляем строку новой модели: FDQuery_Engin.Insert; FDQuery_Engin.FieldByName('Name_Harak').AsString:=Edit_НазваниеХарактеристики.Text; //заносим в поток файл картинки IconStream:=TMemoryStream.Create; Image_ФотоХаракДвиг.Bitmap.SaveToStream(IconStream); IconStream.Position := 0; (FDQuery_Engin.FieldByName('Harak_Engin') as TBlobField).LoadFromStream(IconStream); IconStream.Free; FDQuery_Engin.Post; ShowMessage('Введено.'); Except ShowMessage('Ошибка ввода в базу.'); End; end; //перезагружаем Boxы Box_НазвХарДвиг.Clear; Box_НазвХарДвигУдаление.Clear; FDQuery_ComboBox_Engin.Active:=False; FDQuery_ComboBox_Engin.SQL.Clear; FDQuery_ComboBox_Engin.SQL.Add('SELECT Name_Harak FROM Tab_Harak_Engin ORDER BY Name_Harak'); FDQuery_ComboBox_Engin.Active:=True; for i:=1 to FDQuery_ComboBox_Engin.RecordCount do begin FDQuery_ComboBox_Engin.RecNo:=i; Box_НазвХарДвиг.Items.Add(FDQuery_ComboBox_Engin.FieldByName('Name_Harak').AsString); Box_НазвХарДвигУдаление.Items.Add(FDQuery_ComboBox_Engin.FieldByName('Name_Harak').AsString); end; end; Так удаляю из базы если надо: //удалить procedure TForm_haracteristik.Button_УдалитьClick(Sender: TObject); begin if Box_НазвХарДвигУдаление.ItemIndex=-1 then begin ShowMessage('Вы не выбрали имя характеристики.'); Abort; end; TX:=''; TX:=Box_НазвХарДвигУдаление.Selected.Text; //становимся на эту позицию FDQuery_Engin.Active:=False; FDQuery_Engin.SQL.Clear; FDQuery_Engin.SQL.Add('SELECT * FROM Tab_Harak_Engin where Name_Harak= '+#39+TX+ #39); FDQuery_Engin.Active:=True; Try FDQuery_Engin.Delete; ShowMessage('Удалено.'); Except ShowMessage('Не удалось удалить.'); End; //перезагружаем Boxы Box_НазвХарДвиг.Clear; Box_НазвХарДвигУдаление.Clear; FDQuery_ComboBox_Engin.Active:=False; FDQuery_ComboBox_Engin.SQL.Clear; FDQuery_ComboBox_Engin.SQL.Add('SELECT Name_Harak FROM Tab_Harak_Engin ORDER BY Name_Harak'); FDQuery_ComboBox_Engin.Active:=True; for i:=1 to FDQuery_ComboBox_Engin.RecordCount do begin FDQuery_ComboBox_Engin.RecNo:=i; Box_НазвХарДвиг.Items.Add(FDQuery_ComboBox_Engin.FieldByName('Name_Harak').AsString); Box_НазвХарДвигУдаление.Items.Add(FDQuery_ComboBox_Engin.FieldByName('Name_Harak').AsString); end; end; Так просматриваю: //просмотр картинки procedure TForm_haracteristik.ComboBox_НазвХарДвигChange(Sender: TObject); begin //становимся на эту позицию //FDQuery_Engin.Locate('Name_Harak',TX,[loPartialKey, loCaseInsensitive]); FDQuery_Engin.Active:=False; FDQuery_Engin.SQL.Clear; FDQuery_Engin.SQL.Add('SELECT * FROM Tab_Harak_Engin where Name_Harak= '+#39+Box_НазвХарДвиг.Selected.Text+ #39); FDQuery_Engin.Active:=True; Try //заносим в поток файл картинки IconStream:=TMemoryStream.Create; (FDQuery_Engin.FieldByName('Harak_Engin') as TBlobField).SaveToStream(IconStream); If IconStream.Size<>0 then begin IconStream.Position:=0; Image_Просмотр.Bitmap.LoadFromStream(IconStream); IconStream.Free; end else begin ShowMessage('Нет фото.'); Exit; end; Except ShowMessage('Не удалось загрузить фото.'); End; end;

procedure TfrmPrincipal.AdicionarSomenteOfertasLista; var Tarefa: ITask; begin dmDadosLocais.qryListaSomenteOfertas.Active := False; dmDadosLocais.qryListaSomenteOfertas.ParamByName('IDOFFSET').AsInteger := TotalSomenteOfertasOFFSET; dmDadosLocais.qryListaSomenteOfertas.Active := True; dmDadosLocais.qryListaSomenteOfertas.First; Tarefa := TTask.Create( procedure() var strOferta, strEmpresa, strSloganEmpresa, strIDOferta: string; // LItem: TListViewItem; //Lista de Imagens ItemFolder: TListItemImage; Background: TListItemImage; LogoMarca: TListItemImage; IconeCupom: TListItemImage; IconeCurtidas: TListItemImage; // Tratablhar com imagens ImgStream, ImgStreamLogoEmpresa: TStream; ImagemAlterada: TBitmap; ImagemBackGround: TBitmap; ImagemLogoMarca: TBitmap; ImagemCupom: TBitmap; UsarCupom: Boolean; //Posicionamento ItemTituloOferta, ItemEmpresa, ItemSlogan, ItemNumeroCurtidas: TListItemText; vKoef: Single; AlturaImagem: Single; AvailableWidth: Single; AlturaLvOfertas: Single; Linha: Single; //Texto curtidas strCurtidas: string; begin if dmDadosLocais.qryListaSomenteOfertas.RecordCount > 0 then begin LoadCarregandoSomenteOfertas.Visible := True; lvSomenteOfertas.BeginUpdate; try while not dmDadosLocais.qryListaSomenteOfertas.Eof do begin strOferta := dmDadosLocais.qryListaSomenteOfertas.FieldByName('oferta').AsString; strEmpresa := dmDadosLocais.qryListaSomenteOfertas.FieldByName('empresa').AsString; strIDOferta := dmDadosLocais.qryListaSomenteOfertas.FieldByName('id').AsString; strSloganEmpresa := dmDadosLocais.qryListaSomenteOfertas.FieldByName('slogan').AsString; ImgStream := dmDadosLocais.qryListaSomenteOfertas.CreateBlobStream(dmDadosLocais.qryListaSomenteOfertas.FieldByName('img_media'), TBlobStreamMode.bmRead); ImgStreamLogoEmpresa := dmDadosLocais.qryListaSomenteOfertas.CreateBlobStream(dmDadosLocais.qryListaSomenteOfertas.FieldByName('logomarca'), TBlobStreamMode.bmRead); //Controle de Cupom if dmDadosLocais.qryListaSomenteOfertas.FieldByName('usar_cupom').AsBoolean = True then UsarCupom := True else if dmDadosLocais.qryListaSomenteOfertas.FieldByName('usar_cupom').AsBoolean = False then UsarCupom := False; TThread.Synchronize(TThread.CurrentThread, procedure() begin AvailableWidth := lvSomenteOfertas.Width - lvSomenteOfertas.ItemSpaces.Left - lvSomenteOfertas.ItemSpaces.Right; ImagemAlterada := TBitmap.Create; ImagemAlterada.LoadFromStream(ImgStream); {Tamanho e Posicionamento} if Handle = nil then exit; // on Android without this user will get Access Violation vKoef := AvailableWidth / ImagemAlterada.Width; AlturaImagem := ImagemAlterada.Height * vKoef; LItem := lvSomenteOfertas.Items.Add; LItem.Height := (Round(AlturaImagem) + 5 + 22 + 5 + 40 + 3 + 20 + 30); //Atribui valores LItem.Data['Oferta'] := strOferta; LItem.Data['Empresa'] := strEmpresa; LItem.Data['IDOferta'] := strIDOferta; LItem.Data['SloganEmpresa'] := strSloganEmpresa; strCurtidas := dmDadosLocais.NumeroDeCurtidasFEED(StrToInt(strIDOferta)); LItem.Data['NumeroCurtidas'] := strCurtidas; if strCurtidas.IsEmpty = True then LItem.Data['IconeCurtida'] := 0 else if strCurtidas.IsEmpty = False then LItem.Data['IconeCurtida'] := 1; //Folder ItemFolder := TListItemImage(LItem.View.FindDrawable('Folder')); ItemFolder.OwnsBitmap := True; ItemFolder.Bitmap := ImagemAlterada; ImagemAlterada.Free; ItemFolder.Height := AlturaImagem; Background := TListItemImage(LItem.View.FindDrawable('Background')); Background.Visible := False; //LogoEmpresa LogoMarca := TListItemImage(LItem.View.FindDrawable('LogoEmpresa')); ImagemLogoMarca := TBitmap.Create; LogoMarca.OwnsBitmap := True; ImagemLogoMarca.LoadFromStream(ImgStreamLogoEmpresa); LogoMarca.Bitmap := ImagemLogoMarca; ImagemLogoMarca.Free; //Icone do Cupom IconeCupom := TListItemImage(LItem.View.FindDrawable('iconeCUPOM')); ImagemCupom := TBitmap.Create; IconeCupom.OwnsBitmap := True; if UsarCupom = True then ImagemCupom := imgIconeCupom.Bitmap else if UsarCupom = False then ImagemCupom := imgIconeSemCupom.Bitmap; IconeCupom.Bitmap := ImagemCupom; ImagemCupom.Free; //Localiza Objetos IconeCurtidas := TListItemImage(LItem.View.FindDrawable('IconeCurtida')); ItemTituloOferta := TListItemText(LItem.View.FindDrawable('Oferta')); ItemEmpresa := TListItemText(LItem.View.FindDrawable('Empresa')); ItemSlogan := TListItemText(LItem.View.FindDrawable('SloganEmpresa')); ItemNumeroCurtidas := TListItemText(LItem.View.FindDrawable('NumeroCurtidas')); // Posiciona Objetos nos controles Linha := 5; //Linha 1 - Dados da empresa LogoMarca.PlaceOffset.Y := Linha; ItemEmpresa.PlaceOffset.Y := Linha; ItemEmpresa.PlaceOffset.X := 60; ItemSlogan.PlaceOffset.Y := Linha + 21; ItemSlogan.PlaceOffset.X := 60; //Linha 2 - Folder da Oferta Linha := Linha + LogoMarca.Height + 7; ItemFolder.PlaceOffset.Y := Linha; //Linha 3 - Titulo da oferta Linha := Linha + AlturaImagem + 5; ItemTituloOferta.PlaceOffset.Y := Linha; //Linha 4 - Número de Curtidas Linha := Linha + ItemTituloOferta.Height + 3; ItemNumeroCurtidas.PlaceOffset.Y := Linha; IconeCurtidas.PlaceOffset.Y := Linha; end); dmDadosLocais.qryListaSomenteOfertas.Next; end; finally lvSomenteOfertas.EndUpdate; // if TotalSomenteOfertasOFFSET = 0 then // TThread.Synchronize(nil, RepintarOfertasDesalinhadas); TotalSomenteOfertasOFFSET := TotalSomenteOfertasOFFSET + 10; TThread.Synchronize(TThread.CurrentThread, procedure() begin if TotalSomenteOfertasOFFSET = 10 then RepintarOfertasDesalinhadas(lvSomenteOfertas); LoadCarregandoSomenteOfertas.Visible := False; end); end; end; end); Tarefa.Start; end;

это очень нехорошо. должно быть query.Open; grid.RowCount:=query.RecordCount; // это не очень верно, но пока ладно... n:=0; while not query.eof do begin FillRow(n); query.Next; inc(n); end; query.Close; ну и да, соглашусь. даже секунда, это многовато...

kraporkin, спасибо! Проблема не решилась. Изначально я убрал LiveBindings , т.к. думал тормозит заливка грида из-за него. А заливка даже ручная, какую я написал всё-равно тормозит и заливает в грид секунд 15-20... MainForm.StringGrid1.BeginUpdate; try MainForm.qClients.First; for i:=0 to MainForm.qClients.RecordCount-1 do begin MainForm.StringGrid1.RowCount:=MainForm.StringGrid1.RowCount+1; MainForm.StringGrid1.Cells[0, i] :=MainForm.qClients.FieldByName('FAM').AsString; MainForm.StringGrid1.Cells[1, i] :=MainForm.qClients.FieldByName('IM').AsString; MainForm.StringGrid1.Cells[2, i] :=MainForm.qClients.FieldByName('ID').AsString; MainForm.zqClients.Next; end; finally MainForm.StringGrid1.EndUpdate; end;

Grid2.BeginUpdate; try for i:=0 to qClients.RecordCount-1 do begin XXX:=qClients.Fields[0].AsString; qClients.Next; end; finally Grid2.EndUpdate; end; Что должно быть вместо XXX?

Приветствую! Некорректно отрабатывает поток в Андройде, а именно мерцания экрана procedure Tspotok.Add; begin Form1.foot.Add(Form1.ListBox1); end; procedure Tspotok.Add2; begin Form1.st.Add(Form1.ListBox1); end; procedure Tspotok.Add3; begin Form1.st.ListImage.Items[Form1.st.ListvName.Count-1].Bitmap.LoadFromStream(BlobStream); end; procedure Tspotok.Execute; var FDConnection1: TFDConnection; FDQuery1: TFDQuery; FDPhysSQLiteDriverLink1: TFDPhysSQLiteDriverLink; FDGUIxWaitCursor1: TFDGUIxWaitCursor; j,i:integer; begin FDConnection1:=TFDConnection.Create(nil); FDConnection1.DriverName:='SQLite'; FDPhysSQLiteDriverLink1:=TFDPhysSQLiteDriverLink.Create(nil); FDGUIxWaitCursor1:=TFDGUIxWaitCursor.Create(nil); FDQuery1:=TFDQuery.Create(nil); {$IFDEF ANDROID} FDConnection1.Params.Values['Database'] := TPath.Combine(TPath.GetDocumentsPath, 'base.db'); {$ENDIF} {$IFDEF MSWINDOWS} FDConnection1.Params.Values['Database'] :='E:\Embarcadero\Studio\Projects\NANDBOOK_TWO\base.db'; {$ENDIF} FDConnection1.Connected:=TRUE; for I := 0 to 16 do begin FDQuery1.SQL.Text:='SELECT * FROM '+Form1.NameBaseconst+' WHERE name LIKE "'+Form1.v+'%"'; FDQuery1.Connection:=FDConnection1; FDQuery1.Active := True; FDQuery1.Open; Synchronize(Add); Form1.foot.ListvName.Items[Form1.foot.List.Count-1].Text:=Form1.NameB; if FDQuery1.RecordCount=0 then begin Form1.foot.List.Items[Form1.foot.List.Count-1].Visible:=false; end; if not FDQuery1.IsEmpty then begin //Log.d('LOG-FDQuery1.RecordCount='+FDQuery1.RecordCount.ToString()); for j := 0 to FDQuery1.RecordCount-1 do begin Synchronize(Add2); Form1.st.List.Items[Form1.st.ListvName.Count-1].Parent:= Form1.ListBox1; Form1.st.ListTag.Items[Form1.st.ListvName.Count-1].Text:=IntToStr(Form1.ListBox1.Count-1); Form1.st.ListvName.Items[Form1.st.ListvName.Count-1].Text :=FDQuery1.FieldByName('name').AsString; Form1.st.ListBase.Items[Form1.st.ListvName.Count-1].Text :=Form1.NameBaseconst; Form1.st.ListID.Items[Form1.st.ListvName.Count-1].Text :=FDQuery1.FieldByName('id').AsString; BlobStream:=TStream.Create; BlobStream := FDQuery1.CreateBlobStream(FDQuery1.FieldByName('image'),TBlobStreamMode.bmRead); Synchronize(Add3); FDQuery1.Next; end; end; FDQuery1.Close; FDQuery1.Active := false; end; FDConnection1.Connected:=false; end; end. А в осном unite var QW:Tspotok; .. QW:=Tspotok.Create(true); QW.FreeOnTerminate:=true; QW.Resume;

Если VCL там есть DBGrid, MyDataSource указать, все само отрисуется. В FMX по сути тоже должен быть способ, типа LiveBindings. Можно рисовать в рукопашную for ( int i = 0; i < fquery->RecordCount; i++ ) { // пройти по записям fquery->RecNo = i + 1; // получить массив данных TByteDynArray da = fquery->Fields->FieldByNumber(0)->AsBytes; // скопировать массив в Stream, // возможно есть другие способы скопировать TByteDynArray в TStream, я на вскидку скопировал побайтно TMemoryStream *ms = new TMemoryStream; ms->SetSize( da.Length ); // занять область под копирование char *ms_data = (char*)ms->Memory; // именованый указатель на область память for( int j = 0; j < da.Length; i++ ) char[i] = da[i]; // копирование побайтно в цикле TBitmap *b = new TBitmap; b->LoadFromStream( ms ); // здесь в битмап уже должно быть изображение delete ms; delete b; }

для заполнения листвью юзаю подобное решение procedure TFVisit.bListViewFill(LV: TListView; FDSource: TFDQuery; TextField, DetailField, TagField: string; IsClear: boolean); var i, index: integer; item: TListViewitem; begin if LV.Selected <> nil then index:= LV.Selected.Index else index:= -1; if FDSource.IsEmpty then begin // ShowMessage('Нет данных!'); LV.Items.Clear; exit; end; if IsClear then LV.Items.Clear; LV.BeginUpdate; try for i:= 1 to FDSource.RecordCount do begin FDSource.RecNo:= i; item:= LV.Items.Add; item.Text:= FDSource.FieldByName(TextField).AsString; item.Detail:= FDSource.FieldByName(DetailField).AsString; // item.Bitmap.Assign(...) item.Tag:= FDSource.FieldByName(TagField).AsInteger; end; finally LV.EndUpdate; end; if index = -1 then exit; if (LV.Items.Count >= index) then LV.ItemIndex:= index; end; ну и заполняю tbPriceList: TFDQuery; . . . tbPriceList.Open; //фильтрованный по необходимым условиям bListViewFill(ListView1, tbPriceList, 'Name', 'LCP_Qty', 'ProductId', True); tbPriceList.Close; Мне часто приходится работать с листвью где text, detail и tag... но иногда приходится юзать остальной функционал листвью: хидеры-шмидеры, имейджи и т.д. но это уже другой вопрос

В общем, потестил малость, набросал приложение, сканирующее System32. Дано: 3181 файл (+1 новый для проверки) база с двумя одинаковыми таблицами (по два столбца(id, FileName) в каждой) Результаты: Проверка в цикле, каждый раз по запросу "SELECT * FROM tblFileName WHERE FileName = Имя файла", очень накладно получается примерно 4.8 сек. (4758мс) Проверка с созданием и заполнением временной таблицы и запросом типа такого "select * from `temp` where FileName not in (select FileName from `tblFileName`)", достаточно быстро - 0.4 сек (437мс) Ваш способ - примерно 2.2 сек. (2168мс) Важно заметить, что во втором случае, время замерялось на две задачи, заполнение временной таблицы и сравнение, посредством одного запроса в бд. В первом же случае, данные сразу сравнивались, т.е. замерялся цикл запросов(3181 шт.) на выборку. Выбор очевиден Не знаю, что мне взбрело в голову в предыдущем сообщении...))) По поводу Limit, это ключевое слово позволяет не только ограничивать количество выбираемых данных, но и делать выборку блоками, например по 500 записей за раз (select FileName from `tblFileName` LIMIT 1,500), подошло бы, если бы нужно было извлекать блоками по 500 записей. вот такой запрос: FDQuery2.SQL.Clear; FDQuery2.SQL.Add('SELECT * FROM tblFileName'); FDQuery2.Active := True; FDQuery2.Open; if not FDQuery2.IsEmpty then begin FDQuery2.Last; mLogs.Lines.Add('Всего записей: ' + FDQuery2.RecordCount.ToString); mLogs.Lines.Add('ID последней записи: ' + FDQuery2.FieldByName('ID').AsString); end; FDQuery2.Close; Работает без проблем, извлекает сразу все записи. p.s. Тесты проходили на Windows 7 Pro.

по поводу RecordCount уже миллион раз говорилось, что это количество сфетченных записей а не количество записей в датасете и никогда для перебора не используется цикл for dataset.open; while not dataset.eof do begin ... dataset.next; end; dataset.close; ручное сравнение записей с массивом данных тоже странный алгоритм для работы с SQL сервером все должно сводиться к подготовке данных для сервера и дальнейшей уже серверной работы, а не загрузки всей базы в память 512 Мб

Использую БД SQLite, количество записей перевалило за 2000. Понадобилось перебрать все записи и сравнить с каждую запись с другим массивом данных. Загрузить все данные, а это 2000 с лишним записей сразу не позволяет система, просто ничего не происходит (процедура не исполняется). Поэтому свойство FetchOption.RowsetSize установил 500, свойство FetchOption.Mode установлено в fmOnDemand, т.е.когда обрабатывается порция данных по документации должна быть получена следующая порция данных и так до конца. Однако, на практике при такой конструкции при получении данных, количество данных (RecordCount) приравнивается к св-ву RowsetSize и выводит только 500 записей, а цикл While почему-то не работает, просто ничего не происходит. Как вывести полный объем данных? var DBArray: TStringList; FQuery: TMySQLiteQuery; ........ SQL := 'SELECT * FROM FileStore'; FQuery.SelectQuery(SQL); //while (not FQuery.Eof) do for j := 0 to FQuery.RecordCount - 1 do begin AData := FQuery.Fields.FieldByName('FileName').AsString; DBArray.Append(AData); FQuery.Next; end; ShowMessage(IntToStr(DBArray.Count)); .......

Я нашел решение, к сожалению, пока только для работы с UniDAC: Обновил UniDAC компоненты для Berlin до последней версии (6.3.12). Компоненты TUniConnection и TUniQuery отлично работают с SQLite в Android Service. FireDAC в Android Service пока запустить не удалось, но у меня такой задачи нет. В Deployment host приложения добавляю файл базы данных, Remote Path задаю ".\assets\internal\". И спокойно из сервиса получаю к нему доступ. Мой сервис локальный в одном потоке с приложением. Если делать Intent Service или Remote — наверное, придется помещать файл в другой, доступный каталог, или общаться через намерения (Intents). Надеюсь мой код будет полезен для вас. procedure TDM.conSQLiteBeforeConnect(Sender: TObject); begin {$IF DEFINED(iOS) or DEFINED(ANDROID)} conSQLite.Database := TPath.Combine(TPath.GetDocumentsPath, 'mybase.sqlite'); {$ENDIF} end; procedure TDM.conSQLiteError(Sender: TObject; E: EDAError; var Fail: Boolean); begin Log('--- DB error: %s:', [E.Message]); Fail := False; end; function TDM.AndroidServiceStartCommand(const Sender: TObject; const Intent: JIntent; Flags, StartId: Integer): Integer; begin Log('+ START with Intent: ' + JStringToString(Intent.getAction.toString), []); if Intent.getAction.equalsIgnoreCase(StringToJString('StopIntent')) then begin try conSQLite.Disconnect; Log('- DB disconnected', []); except on E: Exception do Log('- can not to disconnect DB', [E.Message]); end; Log('... service to be stoped', []); JavaService.stopSelf; Result := TJService.JavaClass.START_NOT_STICKY; // don't reload service end else begin Log('... service started', []); try conSQLite.Connect; Log('+ DB connected', []); UniQuery.SQL.Text := 'select count(*) as ALLREC from orders'; UniQuery.Open; if UniQuery.RecordCount > 0 then begin UniQuery.First; Log('... record count: %s', [UniQuery.FieldByName('ALLREC').AsString]); end; UniQuery.Close; except on E: Exception do Log('- can not to connect DB: %s', [E.Message]); end; Result := TJService.JavaClass.START_STICKY; // rerun service if it stops end; end;

RecordCount - это количество зафетченных на клиента записей, а не кол-во записей датасета First; Last; конечно приведут RecordCount в правильное состояние, но вы 10 раз об этом пожалеете, если на мобилу приедут все ваши 100500 записей, а нужно было только 100

для того чтобы узнать сколько записей в таблице, есть функция RecordCount. Возвращает целое число. зная количество сразу и стройте StrGrd

Query.Last; //Переходим к последней записи в выборке X := Query.RecordCount; //Здесь RecordCount уже выдаст правильное количество записей Query.First; // Возвращаемся к первой записи.

Друзья, помогите, пож-та! Как можно подсчитать число записей после формирования выборки с использованием TFDQuery? RecordCount выдает значение 50 (RowsetSize по-умолчанию). Поделитесь, пож-та, примером кода и советом: как RowsetSize менять динамически исходя из объема выборки? Спасибо!

procedure TFPreOrder.ListViewFill(LV: TListView; FDSource: TFDQuery; TextField, DetailField, TagField: string; IsClear: boolean); var i, index: integer; item: TListViewitem; begin if LV.Selected <> nil then index:= LV.Selected.Index else index:= -1; if FDSource.IsEmpty then begin // ShowMessage('Нет данных!'); LV.Items.Clear; exit; end; if IsClear then LV.Items.Clear; try LV.BeginUpdate; for i:= 1 to FDSource.RecordCount do begin FDSource.RecNo:= i; item:= LV.Items.Add; item.Text:= FDSource.FieldByName(TextField).AsString; item.Detail:= FDSource.FieldByName(DetailField).AsString; item.Tag:= FDSource.FieldByName(TagField).AsInteger; end; finally LV.EndUpdate; end; if index = -1 then exit; if LV.Items.Count >= index then LV.ItemIndex:= index; end; я обычно так заполняю... ну TFDQuery на TFDMemTable только сменить зы. ну и заполнение ListViewFill(ListView1, tbPreOrder, 'Name', 'Qty', 'GoodId', True);

Нет, не вызывал. Прочитал в хелпе про FetchOptions, выставил FetchOptions.Manual = fmAll и теперь всё работает как надо. Только не пойму смысла. Если эта опция отвечает якобы за ограничение получения записей, то почему по факту в TFDQuery количество записей было больше выставленного максимума, т.е. все записи, которые возвращает мне запрос? По идее в данном случае в память DataSet не должно было грузиться более 50 записей. А так получается смысла в этой опции нет, она только не даёт свойству RecordCount стать выше установленного максимума, а в DataSet всё равно грузятся все записи, возвращённые запросом, и пройтись по ним можно вызывая в цикле Next() пока свойство Eof не будет истинным.

Здравствуйте, коллеги. В своих разработках мы придерживаемся принципа разделения приложения на слои: 1. Слой доступа к данным - DAL 2. Слой бизнес-логики - BL 3. Слой представления - UI В связи с этим большую часть модулей приложений мы разрабатываем вручную, не прибегая к использованию визуальных компонентов. Все визуальные компоненты (кнопки, гриды, мемо и т. п.) только в слое UI. Также мы поступили и со слоем DAL, разработав собственный провайдер для доступа к базе данных Oracle. Активно используем его уже лет 5 и пока он покрывает все наши нужды. Представляю его вашему вниманию и прошу объективной критики по любому поводу. Интерфейс провайдера: unit OracleProviderInterface; interface uses Ora, DB, Variants, SysUtils, Classes, Contnrs, Spring.Collections ; /// <summary> /// Parameters data type enumeration /// </summary> type TParamDataType = ( pdtDefault = 1, pdtBlob = 2, pdtTable = 3, pdtClob = 4 ); /// <summary> /// Class for CDB database parameter /// </summary> type TCDBOraParam = Class ( TOraParam ) public {$REGION 'Fields'} /// <summary> /// Gets or sets parameter data type /// </summary> ParamDataType : TParamDataType; {$ENDREGION} {$REGION 'Constructors'} /// <summary> /// Creates TCDBOraParam instance /// </summary> constructor Create (); {$ENDREGION} end; /// <summary> /// Interface for database provider /// </summary> type IDatabaseProvider = interface ( IInterface ) ['{BF277F9C-D046-4015-8E17-6B4C67CC021B}'] {$REGION 'Methods'} /// <summary> /// Executes SQL query passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Query execution results</returns> function ExecuteQuery ( query : String; const parameters : IList<TCDBOraParam> = nil ) : TDataSet; /// <summary> /// Executes non-selective (insert, update, delete) SQL passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Number of rows affected</returns> function ExecuteNonQuery ( query : String; const parameters : IList<TCDBOraParam> = nil ) : Integer; /// <summary> /// Executes stored procedure with particular parameters /// </summary> /// <param name="procedureName">Stored procedure name</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Execution results</returns> function ExecuteProcedure ( procedureName : String; const parameters : IList<TCDBOraParam> = nil ) : TOraParams; /// <summary> /// Begins session transaction /// </summary> procedure BeginTransaction (); /// <summary> /// Commits current session transaction /// </summary> procedure CommitTransaction (); /// <summary> /// Rollbacks current session transaction /// </summary> procedure RollbackTransaction (); /// <summary> /// Creates parameter /// </summary> /// <param name="name">Parameter name</param> /// <param name="value">Parameter value</param> /// <param name="paramType">Parameter type (e.g. input or output)</param> /// <param name="paramDataType">Parameter data type (e.g. default or BLOB)</param> /// <returns>Binded parameter</returns> function CreateParameter ( name : String; value : Variant; paramType : TParamType = ptInput; paramDataType : TParamDataType = pdtDefault ) : TCDBOraParam; overload; /// <summary> /// Connects to the server /// </summary> procedure OpenSession (); /// <summary> /// Disconnects from the server /// </summary> procedure CloseSession (); /// <summary> /// Gets session /// </summary> /// <returns>Connection session</returns> function GetSession () : TOraSession; {$ENDREGION} {$REGION 'Properties'} /// <summary> /// Connection session /// </summary> property Session : TOraSession read GetSession; {$ENDREGION} end; implementation { TCDBOraParam } /// <summary> /// Creates TCDBOraParam instance /// </summary> constructor TCDBOraParam.Create (); begin inherited Create ( nil ); ParamDataType := pdtDefault; end; end. Реализация: unit OracleProvider; interface uses Ora, DB, Variants, SysUtils, Classes, Contnrs, MemData, DBAccess, Spring.Container, Spring.Collections, //BL OracleProviderInterface ; /// <summary> /// Data provider to Oracle database /// </summary> type TOracleProvider = class ( TInterfacedObject, IDatabaseProvider ) private {$REGION 'Fields'} /// <summary> /// Database session /// </summary> _session : TOraSession; /// <summary> /// Query /// </summary> _query : TOraQuery; /// <summary> /// SQL-expression /// </summary> _sql : TOraSQL; /// <summary> /// Stored procedure /// </summary> _storedProcedure : TOraStoredProc; /// <summary> /// Flag to understand who owns session /// </summary> _isOwnSession : Boolean; /// <summary> /// Connection string /// </summary> _connectionString : String; {$ENDREGION} {$REGION 'Methods'} /// <summary> /// Gets parameter's field type by Variant value /// </summary> /// <param name="value">value</param> /// <returns>Field type for TOraParam</returns> function GetFieldType ( value : Variant ) : TFieldType; /// <summary> /// Initializes class inner objects /// </summary> /// <param name="isOwnSession">Flag to understand who owns session</param> procedure Initialize ( isOwnSession : Boolean ); /// <summary> /// Gets session /// </summary> /// <returns>Connection session</returns> function GetSession () : TOraSession; {$ENDREGION} public {$REGION 'Methods'} /// <summary> /// Executes SQL query passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Query execution results</returns> function ExecuteQuery ( query : String; const parameters : IList<TCDBOraParam> = nil ) : TDataSet; /// <summary> /// Executes non-selective (insert, update, delete) SQL passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Number of rows affected</returns> function ExecuteNonQuery ( query : String; const parameters : IList<TCDBOraParam> = nil ) : Integer; /// <summary> /// Executes stored procedure with particular parameters /// </summary> /// <param name="procedureName">Stored procedure name</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Execution results</returns> function ExecuteProcedure ( procedureName : String; const parameters : IList<TCDBOraParam> = nil ) : TOraParams; /// <summary> /// Begins session transaction /// </summary> procedure BeginTransaction (); /// <summary> /// Commits current session transaction /// </summary> procedure CommitTransaction (); /// <summary> /// Rollbacks current session transaction /// </summary> procedure RollbackTransaction (); /// <summary> /// Creates parameter /// </summary> /// <param name="name">Parameter name</param> /// <param name="value">Parameter value</param> /// <param name="paramType">Parameter type (e.g. input or output)</param> /// <param name="paramDataType">Parameter data type (e.g. default or BLOB)</param> /// <returns>Binded parameter</returns> function CreateParameter ( name : String; value : Variant; paramType : TParamType = ptInput; paramDataType : TParamDataType = pdtDefault ) : TCDBOraParam; overload; /// <summary> /// Connects to the server /// </summary> procedure OpenSession (); /// <summary> /// Disconnects from the server /// </summary> procedure CloseSession (); {$ENDREGION} {$REGION 'Constructors'} /// <summary> /// Creates TOracleProvider instance with particular connection string /// </summary> /// <param name="connectionString">Connection string</param> constructor Create ( const connectionString : String ); overload; /// <summary> /// Creates TOracleProvider instance with particular session /// </summary> /// <param name="oracleSession">Connection session</param> constructor Create ( const oracleSession : TOraSession ); overload; {$ENDREGION} {$REGION 'Destructors'} /// <summary> /// Safely destroys TOracleProvider instance /// </summary> destructor Destroy (); override; {$ENDREGION} {$REGION 'Properties'} /// <summary> /// Connection session /// </summary> property Session : TOraSession read GetSession; {$ENDREGION} end; implementation {TOracleProvider} /// <summary> /// Creates TOracleProvider instance with particular connection string /// </summary> /// <param name="connectionString">Connection string</param> constructor TOracleProvider.Create ( const connectionString : String ); begin _connectionString := connectionString; Initialize ( true ); end; /// <summary> /// Creates TOracleProvider instance with particular session /// </summary> /// <param name="oracleSession">Connection session</param> constructor TOracleProvider.Create ( const oracleSession : TOraSession ); begin _session := oracleSession; Initialize ( false ); end; /// <summary> /// Initializes class inner objects /// </summary> /// <param name="isOwnSession">Flag to understand who owns session</param> procedure TOracleProvider.Initialize ( isOwnSession : Boolean ); begin if isOwnSession then begin _session := TOraSession.Create ( nil ); _session.ConnectString := _connectionString; _session.Connected := false; _session.LoginPrompt := false; _session.Options.Direct := true; _session.AutoCommit := false; _session.Options.NeverConnect := true; _session.Pooling := true; end; _query := TOraQuery.Create ( nil ); _query.Session := _session; _query.AutoCommit := false; _query.FetchAll := true; _sql := TOraSQL.Create ( nil ); _sql.Session := _session; _sql.AutoCommit := false; _storedProcedure := TOraStoredProc.Create ( nil ); _storedProcedure.Session := _session; _storedProcedure.AutoCommit := false; _storedProcedure.FetchAll := true; _isOwnSession := isOwnSession; end; /// <summary> /// Safely destroys TOracleProvider instance /// </summary> destructor TOracleProvider.Destroy (); begin if _query.Active then begin _query.Close (); end; _query.Free (); if _storedProcedure.Active then begin _storedProcedure.Close (); end; _storedProcedure.Free (); if _isOwnSession then begin if _session.Connected then begin _session.Close (); end; _session.Free (); end; inherited; end; /// <summary> /// Connects to the server /// </summary> procedure TOracleProvider.OpenSession (); begin if _session <> nil then begin try _session.Open (); except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; end; end; /// <summary> /// Disconnects from the server /// </summary> procedure TOracleProvider.CloseSession (); begin if _isOwnSession then begin if ( _session <> nil ) AND ( _session.Connected ) then begin try _session.Close (); except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; end; end; end; /// <summary> /// Begins session transaction /// </summary> procedure TOracleProvider.BeginTransaction (); begin try _session.StartTransaction (); except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; end; /// <summary> /// Commits current session transaction /// </summary> procedure TOracleProvider.CommitTransaction (); begin if _session.InTransaction then begin try _session.Commit (); except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; end; end; /// <summary> /// Rollbacks current session transaction /// </summary> procedure TOracleProvider.RollbackTransaction (); begin if _session.InTransaction then begin try _session.Rollback (); except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; end; end; /// <summary> /// Executes SQL query passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Query execution results</returns> function TOracleProvider.ExecuteQuery ( query : String; const parameters : IList<TCDBOraParam> = nil ) : TDataSet; var i : Integer; param : TOraParam; dataSet : TDataSet; begin dataSet := TDataSet.Create ( nil ); _query.Close (); _query.SQL.Text := query; if Assigned ( parameters ) then begin _query.Params.Clear (); for i := 0 to parameters.Count - 1 do begin param := TOraParam.Create ( nil ); param.Name := TOraParam ( parameters[i] ).Name; param.Value := TOraParam ( parameters[i] ).Value; param.ParamType := TOraParam ( parameters[i] ).ParamType; _query.Params.AddParam ( param ); end; end; try if _session.Connected then begin _query.Execute (); dataSet := _query.Fields.DataSet; dataSet.Active := true; end; except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; Result := dataSet; end; /// <summary> /// Executes stored procedure with particular parameters /// </summary> /// <param name="procedureName">Stored procedure name</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Execution results</returns> function TOracleProvider.ExecuteProcedure ( procedureName : String; const parameters : IList<TCDBOraParam> = nil ) : TOraParams; var i : Integer; j : Integer; begin _storedProcedure.Close (); _storedProcedure.StoredProcName := procedureName; _storedProcedure.Prepare (); if Assigned ( parameters ) then begin for i := 0 to parameters.Count - 1 do begin for j := 0 to _storedProcedure.Params.Count - 1 do begin if _storedProcedure.Params[j].Name = TOraParam ( parameters[i] ).Name then begin _storedProcedure.Params[j] := TOraParam ( parameters[i] ); if TCDBOraParam ( parameters[i] ).ParamDataType = pdtBlob then begin if ( ( TOraParam ( parameters[i] ).Value <> Null ) AND ( TOraParam ( parameters[i] ).Value <> '') ) then begin _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).DataType := ftOraBlob; _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).ParamType := TOraParam ( parameters[i] ).ParamType; _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).AsOraBlob.LoadFromFile ( TOraParam ( parameters[i] ).Value ); end else begin _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).DataType := ftOraBlob; _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).ParamType := TOraParam ( parameters[i] ).ParamType; _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).AsOraBlob.FreeBlob (); end; end; if TCDBOraParam ( parameters[i] ).ParamDataType = pdtClob then begin if ( ( TOraParam ( parameters[i] ).Value <> Null ) AND ( TOraParam ( parameters[i] ).Value <> '') ) then begin _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).DataType := ftOraClob; _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).ParamType := TOraParam ( parameters[i] ).ParamType; _storedProcedure.ParamByName ( TOraParam ( parameters[i] ).Name ).Value := TOraParam ( parameters[i] ).Value; end; end; end; end; end; end; if _session.Connected then begin try _storedProcedure.Execute (); Result := _storedProcedure.Params; except on e : Exception do begin raise Exception.Create ( e.Message ); end; end; end else begin Result := TOraParams.Create ( nil ); end; end; /// <summary> /// Executes non-selective (insert, update, delete) SQL passed with parameters /// </summary> /// <param name="query">SQL query text</param> /// <param name="parameters">Binded query parameters</param> /// <returns>Number of rows affected</returns> function TOracleProvider.ExecuteNonQuery ( query : String; const parameters : IList<TCDBOraParam> = nil ) : Integer; var i : Integer; begin _query.Close (); _query.SQL.Clear (); _query.SQL.Text := query; if Assigned ( parameters ) then begin _query.Params.Clear (); for i := 0 to parameters.Count - 1 do begin _query.Params.AddParam ( TOraParam ( parameters[i] ) ); end; end; if _session.Connected then begin _query.ExecSQL (); Result := _query.RowsAffected; end else begin Result := 0; end; end; /// <summary> /// Creates parameter /// </summary> /// <param name="name">Parameter name</param> /// <param name="value">Parameter value</param> /// <param name="paramType">Parameter type (e.g. input or output)</param> /// <param name="paramDataType">Parameter data type (e.g. default or BLOB)</param> /// <returns>Binded parameter</returns> function TOracleProvider.CreateParameter ( name : String; value : Variant; paramType : TParamType = ptInput; paramDataType : TParamDataType = pdtDefault ) : TCDBOraParam; var parameter : TCDBOraParam; begin parameter := TCDBOraParam.Create (); parameter.Name := UpperCase ( name ); parameter.ParamType := paramType; parameter.DataType := GetFieldType ( value ); case paramDataType of pdtDefault: begin parameter.Value := value; end; pdtBlob: begin parameter.Value := value; end; pdtClob: begin parameter.Value := value; end; pdtTable: begin parameter.Table := true; parameter.DataType := ftFloat; parameter.Value := value; end; end; parameter.ParamDataType := paramDataType; Result := parameter; end; /// <summary> /// Gets parameter's field type by Variant value /// </summary> /// <param name="value">value</param> /// <returns>Field type for TOraParam</returns> function TOracleProvider.GetFieldType ( value : Variant ) : TFieldType; var fieldType : TFieldType; begin case VarType ( value ) AND VarTypeMask of varString : fieldType := TFieldType.ftWideString; varUString : fieldType := TFieldType.ftWideString; varInteger : fieldType := TFieldType.ftInteger; varByte : fieldType := TFieldType.ftInteger; varDate : fieldType := TFieldType.ftDate; else fieldType := TFieldType.ftUnknown; end; Result := fieldType; end; /// <summary> /// Gets session /// </summary> /// <returns>Connection session</returns> function TOracleProvider.GetSession () : TOraSession; begin Result := _session; end; initialization GlobalContainer.RegisterType<TOracleProvider>.Implements<IDatabaseProvider> ( 'Oracle' ); end. Использование: 1. Объявляем: var _provider : IDatabaseProvider; 2. Инициализируем: var _connectionString := login + '/' + password + '@' + HostName + ':' + Port + ':' + SID; _provider := GlobalContainer.Resolve<IDatabaseProvider> ( 'Oracle', [connectionString] ); _provider.OpenSession (); 3. Собственно использование: 3.1 Получаем выборку (SELECT): function TVSPHelper.GetVSPListByWellId ( wellId : Integer ) : IList<IVSP>; var list : IList<IVSP>; item : IVSP; query : String; dataSet : TDataSet; i : Integer; j : Integer; parameters: IList<TCDBOraParam>; report : IReport; begin query := 'SELECT ' + 'id, ' + 'comments, ' + 'wellbore_id, ' + 'wellbore_name, ' + 'wellbore_comments, ' + 'wellbore_depth, ' + 'begin_date, ' + 'end_date, ' + 'expedition_id, ' + 'expedition_name, ' + 'organization_id, ' + 'organization_name, ' + 'subject_id, ' + 'subject_name, ' + 'well_id, ' + 'well_name, ' + 'well_comments, ' + 'well_x, ' + 'well_y, ' + 'well_altitude, ' + 'well_rotary_table_elevation ' + ' FROM ' + 'seis.v_vsp ' + ' WHERE ' + 'well_id = :ID '; parameters := TCollections.CreateList<TCDBOraParam> ( true ); parameters.Add ( _provider.CreateParameter ( 'ID', wellId ) ); dataSet := _provider.ExecuteQuery ( query, parameters ); list := TCollections.CreateList<IVSP>; dataSet.First (); for i := 0 to dataSet.RecordCount - 1 do begin item := GlobalContainer.Resolve<IVSP>; item.Id := dataSet.FieldByName ( 'id' ).AsInteger; item.Comments := dataSet.FieldByName ( 'comments' ).AsString; item.BeginDate := dataSet.FieldByName ( 'begin_date' ).AsDateTime; item.EndDate := dataSet.FieldByName ( 'end_date' ).AsDateTime; item.Wellbore.Id := dataSet.FieldByName ( 'wellbore_id' ).AsInteger; item.Wellbore.Name := dataSet.FieldByName ( 'wellbore_name' ).AsString; item.Wellbore.Comments := dataSet.FieldByName ( 'wellbore_comments' ).AsString; item.Wellbore.Depth := dataSet.FieldByName ( 'wellbore_depth' ).AsFloat; item.Expedition.Id := dataSet.FieldByName ( 'expedition_id' ).AsInteger; item.Expedition.Name := dataSet.FieldByName ( 'expedition_name' ).AsString; item.Organization.Id := dataSet.FieldByName ( 'organization_id' ).AsInteger; item.Organization.Name := dataSet.FieldByName ( 'organization_name' ).AsString; item.Wellbore.Well.Subject.Id := dataSet.FieldByName ( 'subject_id' ).AsInteger; item.Wellbore.Well.Subject.Name := dataSet.FieldByName ( 'subject_name' ).AsString; item.Wellbore.Well.Id := dataSet.FieldByName ( 'well_id' ).AsInteger; item.Wellbore.Well.Name := dataSet.FieldByName ( 'well_name' ).AsString; item.Wellbore.Well.Comments := dataSet.FieldByName ( 'well_comments' ).AsString; item.Wellbore.Well.X := dataSet.FieldByName ( 'well_x' ).AsFloat; item.Wellbore.Well.Y := dataSet.FieldByName ( 'well_y' ).AsFloat; item.Wellbore.Well.Altitude := dataSet.FieldByName ( 'well_altitude' ).AsFloat; item.Wellbore.Well.RotaryTableElevation := dataSet.FieldByName ( 'well_rotary_table_elevation' ).AsFloat; list.Add ( item ); dataSet.Next (); end; Result := list; end; 3.2 Вызов хранимой процедуры: function TVSPHelper.GetShotpointMap ( shotpoint : IVSPShotpoint ) : String; var procedureName : String; parameters: IList<TCDBOraParam>; returnParameters : TOraParams; imageURL : String; errorCode : Integer; errorMessage : String; begin procedureName := 'seis.geometric_functions.p_get_shotpoint_map'; parameters := TCollections.CreateList<TCDBOraParam> ( true ); parameters.Add ( _provider.CreateParameter ( 'operation', 0 ) ); parameters.Add ( _provider.CreateParameter ( 'shotpoint_id_in', shotpoint.Id ) ); parameters.Add ( _provider.CreateParameter ( 'image_url', '', ptOutput ) ); parameters.Add ( _provider.CreateParameter ( 'error_code', 0, ptOutput ) ); parameters.Add ( _provider.CreateParameter ( 'error_message', '', ptOutput ) ); try _provider.BeginTransaction (); returnParameters := _provider.ExecuteProcedure ( procedureName, parameters ); imageURL := returnParameters.ParamByName ( 'image_url' ).AsString; errorCode := returnParameters.ParamByName ( 'error_code' ).AsInteger; errorMessage := returnParameters.ParamByName ( 'error_message' ).AsString; if errorCode = 0 then begin _provider.CommitTransaction (); end else begin _provider.RollbackTransaction (); end; except _provider.RollbackTransaction (); raise; end; imageURL := AnsiReplaceStr ( imageURL, 'https', 'http' ); Result := imageURL; end; 3.3 Выполнение операций CRUD: procedure TAdministrationUserHelper.SetUserStatus ( userId : Integer; status : Integer ); var query : String; begin query := 'UPDATE seis.users SET status_id = ' + IntToStr ( status ); try Provider.BeginTransaction (); Provider.ExecuteNonQuery ( query ); Provider.CommitTransaction (); except Provider.RollbackTransaction (); raise; end; end; Стоит заметить, что данный провайдер прекрасно подходит как для десктоп-приложений, так и для мобильных приложений. Конечно с небольшими изменениями, но принцип и структура не меняются. Кому будет интересно, могу выложить код провайдера для работы с БД SQLite, который я использовал для приложений под iOS.