powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Индикатор прогресса закачки/выкачки в/из BLOB.
15 сообщений из 15, страница 1 из 1
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39429110
Mironico
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Добрый день!
Юзается Delphi(XE8)+Firebird(2.5)+FIBPlus(7.7).
Есть проект где через BLOB гоняются файлы.
Можно ли как-то выводить прогресс загрузки файла в BLOB
и выкачки файла из оного?

Код: pascal
1.
2.
TBlobField(DSSt.FieldByName('file_tranfer')).LoadFromFile(Path_to_file_tranfer);
TBlobField(DSSt.FieldByName('file_tranfer')).SaveToFile(Path_to_save);



Файлы не слишком большие, в пределах локалки быстро работает
а вот по удаленке нужно бы чет показывать.
...
Рейтинг: 0 / 0
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39429127
Valery_B
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Mironico,

Стандартными средствами Delphi - никак.

В MS SQL у поля VarBinary есть метод .Write, цель которого записывать данные блоками.
Напиши сторед процедуру, и вызывай её N раз, записывая блоками и вычисляя прогресс.

Чтение данных - аналогично, только используй SubString + Convert.
...
Рейтинг: 0 / 0
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39429162
Dimitry Sibiryakov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
MironicoМожно ли как-то выводить прогресс загрузки файла в BLOB и выкачки файла из оного?

Можно, но не с этими толстыми обёртками. При использовании непосредственно API - никаких
проблем нет.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39429178
Фотография DarkMaster
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Dimitry SibiryakovМожно, но не с этими толстыми обёртками.


Можно и с обертками, модифицировав код получения куска блоба.
...
Рейтинг: 0 / 0
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39429190
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
MironicoFIBPlus(7.7).С FIBPlus не работал, так что не знаю. А для IBX делается так:

Наследуетесь от TIBBlobStream и переопределяете методы Read, Write,
Вместо TIBDataSet используете TIBSQL и там создаете своего наследника TIBBlobStream
Если использование датасета критично, то наследуетесь от TIBDataSet и переопределяете метод CreateBlobStream (хотя в этом случае много геморроя)
...
Рейтинг: 0 / 0
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39429251
Mironico
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Понятненько.
Спасибо всем за ответы!
...
Рейтинг: 0 / 0
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39429266
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Или можно организовать прогресс на приемном конце
TProgressStream
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
  TProgressStream = class(TStream)
  strict private
    FStream: TStream;
    FOwnership: TStreamOwnership;
    FOnProgress: TNotifyEvent;
  strict private
    procedure DoProgress;
  protected
    function GetSize: Int64; override;
    procedure SetSize(const ANewSize: Int64); override;
  public
    constructor Create(AStream: TStream; ABufSize: Integer;
      AOwnership: TStreamOwnership = soReference);
    destructor Destroy; override;
    function Read(var ABuffer; ACount: Longint): Longint; override;
    function Write(const ABuffer; ACount: Longint): Longint; override;
    function Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64; override;
  public
    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
  end;

constructor TProgressStream.Create(AStream: TStream; ABufSize: Integer;
  AOwnership: TStreamOwnership);
begin
  inherited Create;
  FStream := AStream;
  FOwnership := AOwnership;
end;

destructor TProgressStream.Destroy;
begin
  if FOwnership = soOwned then
    FStream.Free;
  inherited Destroy;
end;

procedure TProgressStream.DoProgress;
begin
  if Assigned(FOnProgress) then
    FOnProgress(Self);
end;

function TProgressStream.GetSize: Int64;
begin
  Result := FStream.Size;
end;

procedure TProgressStream.SetSize(const ANewSize: Int64);
begin
  FStream.Size := ANewSize;
end;

function TProgressStream.Read(var ABuffer; ACount: Integer): Longint;
begin
  Result := FStream.Read(ABuffer, ACount);
  DoProgress;
end;

function TProgressStream.Write(const ABuffer; ACount: Integer): Longint;
begin
  Result := FStream.Write(ABuffer, ACount);
  DoProgress;
end;

function TProgressStream.Seek(const AOffset: Int64; AOrigin: TSeekOrigin): Int64;
begin
  Result := FStream.Seek(AOffset, AOrigin);
end;


Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
var
  LStrm: TProgressStream;
begin
  LStrm := TProgressStream.Create(TFileStream(Path_to_file_tranfer, fmOpenRead), soOwned);
  try
    LStrm.OnProgress = ...;
    TBlobField(DSSt.FieldByName('file_tranfer')).LoadFromStream(LStrm);
  finally
    LStrm.Free;
  end;
...
Рейтинг: 0 / 0
Период между сообщениями больше года.
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39787301
BasilCat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

Код: pascal
1.
2.
3.
4.
5.
6.
7.
LStrm := TProgressStream.Create(TFileStream(Path_to_file_tranfer, fmOpenRead), soOwned);

      if OpenDialog_Rar.Execute then
      BEGIN
          S := OpenDialog_Rar.FileName;
         
         LStrm := TProgressStream.Create(TFileStream(s, fmOpenRead), soOwned);




авторДикое преобразование не работает: после запятой выделенного пишет ')' expected but ',' found
[img=]
авторСкорее всего так нужно]:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
procedure TForm1.Button2Click(Sender: TObject);
var
  S, S_N:string;
  LStrm: TProgressStream;
begin
      if OpenDialog_Rar.Execute then
      BEGIN
          S := OpenDialog_Rar.FileName;
          S_N:=ExtractFileName(OpenDialog_Rar.FileName);
  LStrm := TProgressStream.Create(TFileStream.Create(s, fmOpenRead), 264 ,soOwned);
    Table1.Edit;
  try
      LStrm.OnProgress := Progress_Main;
      TBlobField(DataSource1.DataSet.FieldByName('DXF_SAKAS')).LoadFromFile(S);
  finally
    LStrm.Free;
  end;

       DBGrid1.DataSource.DataSet.FieldByName('File_Rar').AsString:=S_N;
    Table1.Post;
    END;
end;


procedure TForm1.Progress_Main(Sender: TObject);
begin
     Label_TIME.Caption:=TimeToStr(SysUtils.Time);
     Panel_Flash1.SetError('ÑÒÐÎÊÀ ÊÎÏÈÐÓÅÒÑß, ÆÄÈÒÅ: '+Label_TIME.Caption,cf_Message);
end;



Ошибка вылазит при попытке выполнить выделенное TBlobField(DataSource1.DataSet.FieldByName('DXF_SAKAS')).LoadFromFile(S); потому что файл занял процесс индикации
Без индикатора всё ОК.
Ваш вердикт.
...
Рейтинг: 0 / 0
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39787302
BasilCat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,
...
Рейтинг: 0 / 0
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39787303
Dimitry Sibiryakov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BasilCatВаш вердикт.

"Тут программист нужен." (с)
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39787305
BasilCat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Dimitry Sibiryakov,

А _Vasilisk_ давший код, что молчит.
Неужели у всех работает.
После его сообщения все молчат почему-то.
В инете по этой проблеме всюду его код!!!
...
Рейтинг: 0 / 0
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39787317
BasilCat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
_Vasilisk_,

Вот так пишет:

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
procedure TForm1.Button2Click(Sender: TObject);
var
  S, S_N:string;
  LStrm: TProgressStream;
  FileStream:TStream;
begin
      if OpenDialog_Rar.Execute then
      BEGIN
          S := OpenDialog_Rar.FileName;
          S_N:=ExtractFileName(OpenDialog_Rar.FileName);
      FileStream:= TFileStream.Create(s, fmOpenRead);
      LStrm := TProgressStream.Create(FileStream, 1024 ,soOwned);

    Table1.Edit;
  try
      LStrm.OnProgress := Progress_Main;
      TBlobField(DataSource1.DataSet.FieldByName('DXF_SAKAS')).LoadFromStream(FileStream);
//      Panel_Flash1.SetError('ÑÒÐÎÊÀ ÊÎÏÈÐÓÅÒÑß, ÆÄÈÒÅ: '+Label_TIME.Caption,cf_Message);
  finally
    LStrm.Free;
  end;

       DBGrid1.DataSource.DataSet.FieldByName('File_Rar').AsString:=S_N;
    Table1.Post;
    END;
end;


procedure TForm1.Progress_Main(Sender: TObject);
begin
    // Label_TIME.Caption:=TimeToStr(SysUtils.Time);
     Panel_Flash1.SetError('ÑÒÐÎÊÀ ÊÎÏÈÐÓÅÒÑß, ÆÄÈÒÅ: '+Label_TIME.Caption,cf_Message);
end;



Код: plaintext
1.
2.
Но категорически не заходит в Progress_Main.
Скорее всего я его неправильно организовал.
Кто знает как  LStrm.OnProgress описать правильно.
...
Рейтинг: 0 / 0
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39787344
BasilCat
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Сделал так, работает:

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
  TStreamProgressEvent = procedure(Sender: TObject;
    Percentage: Single) of object;

  TProgressFileStream = class(TFileStream)
  private
    FOnProgress: TStreamProgressEvent;
    FProcessed: Int64;
    FSize: Int64;
  public
    procedure InitProgressCounter(ASize: Int64);
    function Read(var Buffer; Count: Integer): Integer; override;
    function Write(const Buffer; Count: Integer): Integer; override;
    property OnProgress: TStreamProgressEvent read FOnProgress
      write FOnProgress;
  end;


...

procedure TProgressFileStream.InitProgressCounter(ASize: Int64);
begin
  FProcessed := 0;
  if ASize <= 0 then
    FSize := 1
  else
    FSize := ASize;
  if Assigned(FOnProgress) then
    FOnProgress(Self, 0);
end;

function TProgressFileStream.Read(var Buffer; Count: Integer): Integer;
begin
  Result := inherited Read(Buffer, Count);
  Inc(FProcessed, Result);
  if Assigned(FOnProgress) then
    FOnProgress(Self, FProcessed / FSize);
end;

function TProgressFileStream.Write(const Buffer; Count: Integer): Integer;
begin
  Result := inherited Write(Buffer, Count);
  Inc(FProcessed, Result);
  if Assigned(FOnProgress) then
    FOnProgress(Self, FProcessed / FSize);
end;


// В Form...
  StringGrid_rar: TStringGrid
  ProgressBar:TProgressBar;
  procedure StreamProgress(Sender: TObject; Percentage: Single);

...
procedure TForm1.StreamProgress(Sender: TObject; Percentage: Single);
begin
  ProgressBar.Position := Round(Percentage * ProgressBar.Max);
end;


// Реализация чтения и записи:

// Загружаем из файл в поле Blob
procedure TForm1.Button2Click(Sender: TObject);
var
  S, S_N:string;

  Stream: TProgressFileStream;
begin
      if OpenDialog_Rar.Execute then
      BEGIN
          S := OpenDialog_Rar.FileName;
          S_N:=ExtractFileName(OpenDialog_Rar.FileName);
    Table1.Edit;
          Stream := TProgressFileStream.Create(S, fmOpenRead);
  try
    Stream.OnProgress := StreamProgress;
    Stream.InitProgressCounter(Stream.Size);

      TBlobField(DataSource1.DataSet.FieldByName('DXF_SAKAS')).LoadFromStream(Stream);
  finally
       Stream.InitProgressCounter(Stream.Size);
       Stream.Free;
       DBGrid1.DataSource.DataSet.FieldByName('File_Rar').AsString:=S_N;
  end;

    Table1.Post;
    if DBGrid1.DataSource.DataSet.FieldByName('File_Rar').AsString<>'' then
    begin
        StringGrid_rar.Cells[0,1] :='1';
        StringGrid_rar.Cells[1,1] :=DBGrid1.DataSource.DataSet.FieldByName('File_Rar').AsString;
    end;

    END;
end;


// Пишем из поля Blob в папку \File_BlobWrite\
procedure TForm1.Button300Click(Sender: TObject);
var
 S, S_N:string;
 i:integer;
 a,b: PChar;

begin
   if DBGrid1.DataSource.DataSet.FieldByName('File_Rar').AsString<>'' then
   begin
       S_N := DBGrid1.DataSource.DataSet.FieldByName('File_Rar').AsString;

                                                
    S := FORM_GLOBAL_FILE_PATH_DBase.MString;
    i:=Pos('2',S);
    if i<>0 then
       Delete(S,i,2);   
       TBlobField(DataSource1.DataSet.FieldByName('DXF_SAKAS')).SaveToFile(S+'\File_BlobWrite\'+S_N);
       Panel_Flash1.SetError('Файл извлечён ',cf_Message);
    begin
    a := Pchar('E:\PETROVICH_CYBD\File_BlobWrite\'+S_N);
    b := Pchar('E:\PETROVICH_CYBD\File_BlobWrite\');
    ShellExecute(0, 'open', 'winrar.exe', pchar('x -y '+a+' '+b), nil, SW_show);
    end;
   end
   else
      showmessage('В этой строке файлы не прикреплены!!!');
end;
...
Рейтинг: 0 / 0
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39787610
Arioch
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Очевиднейшая и тупая ошибка вот тут.

BasilCat
Код: pascal
1.
      TBlobField(DataSource1.DataSet.FieldByName('DXF_SAKAS')).LoadFromStream(FileStream);



Смотри откуда автор блоб читает, и откуда ты.
...
Рейтинг: 0 / 0
Индикатор прогресса закачки/выкачки в/из BLOB.
    #39789039
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
BasilCatОшибка вылазит при попытке выполнить выделенное
Код: pascal
1.
TBlobField(DataSource1.DataSet.FieldByName('DXF_SAKAS')).LoadFromFile(S);

потому что файл занял процесс индикацииПравильно.
BasilCatБез индикатора всё ОК.С таким же кодом? Не верю

Хоте индикацию - читайте из стрима. Хотите читать по имени файла - тогда зачем стрим создаете?
...
Рейтинг: 0 / 0
15 сообщений из 15, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Индикатор прогресса закачки/выкачки в/из BLOB.
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]