Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2007.02.25;
Скачать: [xml.tar.bz2];

Вниз

Zlib потоки (TDecompressionStream)   Найти похожие ветки 

 
TCrash   (2006-12-27 10:05) [0]

Доброе время суток.
Возникла проблема с библиотекой Zlib.

type
 TScreenShot=class
   BitMap: TBitMap;
   DC: HDC;
   Bits: TPixelFormat;
   constructor Create;
   destructor Destroy; override;
   procedure Get;
   procedure PackToFile(const FName: string);
   procedure PackToStream(Dest: TStream);
   procedure UnPackFromFile(const FName: string);
   procedure UnPackFromStream(Src: TStream);
 end;

***** SKIPED *****

procedure TScreenShot.PackToFile(const FName: string);
var
 zStream: TCompressionStream;
 Src, Dest: TStream;
 pFN: PCHAR; fH: THandle;
begin
 pFN:=PCHAR(fName);
 fH:=CreateFile(pFN,GENERIC_WRITE,FILE_SHARE_WRITE,nil,CREATE_ALWAYS,FILE_ATTRIBU TE_ARCHIVE,0);
 CloseHandle(fH);
 Dest:=TFileStream.Create(FName,fmOpenWrite);
 Src:=TMemoryStream.Create;
 zStream:=TCompressionStream.Create(clMax,Dest);
 BitMap.SaveToStream(Src);
 zStream.CopyFrom(Src,0);
 zStream.Free;
 Src.Destroy;
 Dest.Free;
end;

procedure TScreenShot.UnPackFromFile(const FName: string);
var
 zStream: TDecompressionStream;
 Src, Dest: TStream;
begin
 Src:=TFileStream.Create(FName,fmOpenRead);
 Dest:=TMemoryStream.Create;
 if Src.Size>0 then begin
   zStream:=TDecompressionStream.Create(Src);
   zStream.CopyFrom(Src,0);
   BitMap.LoadFromStream(zStream);
 end;
 zStream.Free;
 Src.Destroy;
end;


На выделеной строке вываливается Run Time error "EDecompressionError with message "Invalid stream operations"
Код писан по образу и подобию с примера из DRKB v2.3 Может кто ткнет меня пальцем где я ошибся.
PS: открываемый файл существует, не заблокирован и создан при помоши процедуры PackToFile.


 
umbra ©   (2006-12-27 10:20) [1]

Writing to the stream will raise an exception

(C) VCL Help


 
MBo ©   (2006-12-27 10:26) [2]

Перед выделенной строчкой не нужно    zStream.Position обнулить?


 
TCrash   (2006-12-27 11:32) [3]

Обнуление не помогает.
>Umba
Я так понисаю имеется в виду строка zStream.CopyFrom(Src,0); ?
Если да, то как обойтись без нее?


 
umbra ©   (2006-12-27 11:44) [4]

насколько я понимаю, ее надо просто убрать.


 
TCrash   (2006-12-27 15:22) [5]

Перепробовал вроде бы уже все :( и ни чего не добился. Решил переделать с потоков на процедуру DecompressBuf. Вот код

procedure TScreenShot.UnPackFromStream(Src: TStream);
var
 tmpStream: TStream;
 inSize,outSize: integer;
 inBuf,outBuf: pointer;
begin
 if Src.Size>=0 then Src.Read(outSize,4);
 if outSize>0 then begin
   GetMem(outBuf,outSize);
   inSize:=Src.Size-3;
   GetMem(inBuf,inSize);
   Src.Read(inBuf,inSize);
   DecompressBuf(inBuf,inSize,outSize,outBuf,outSize);
   tmpStream:=TMemoryStream.Create;
   tmpStream.Write(outBuf,outSize);
   BitMap.LoadFromStream(tmpStream);
   FreeMem(inBuf);
   FreeMem(outBuf);
   tmpStream.Free;
 end;
end;


Опять вылетает EDecompressionError :(


 
umbra ©   (2006-12-27 16:10) [6]


> ешил переделать с потоков на процедуру DecompressBuf

а что за процедура?


 
ORMADA ©   (2006-12-28 07:06) [7]

держи

procedure PackStream(var OutMemoryStream: TMemoryStream);
var
 UnknownPtr: pointer;
 NewSize: integer;
begin
 OutMemoryStream.Position := 0;
 try
   CompressBuf(OutMemoryStream.Memory, OutMemoryStream.Size, UnknownPtr, NewSize);
   OutMemoryStream.Clear;
   OutMemoryStream.Write(UnknownPtr^, NewSize);
   OutMemoryStream.Position := 0;
 finally
   FreeMem(UnknownPtr, NewSize);
 end;
end;

procedure UnPackStream(var sSrc: TMemoryStream);
var
 UnknownPtr: pointer;
 NewSize: integer;
begin
 sSrc.Position := 0;
 try
   DeCompressBuf(sSrc.Memory, sSrc.Size, 0, UnknownPtr, NewSize);
   sSrc.clear;
   sSrc.Position := 0;
   sSrc.Write(UnknownPtr^, NewSize);
   sSrc.Position := 0;
 finally
   FreeMem(UnknownPtr, NewSize);
 end;
end;


 
TCrash   (2007-01-03 13:10) [8]

>ORMADA ©   (28.12.06 07:06) [7]
Спасибо заработало. И свою ошибку понял :)


 
Ским   (2007-01-08 02:53) [9]

А вот я уже 8 день бьюсь со злибом, и у меня не работает. при компиляции вот этого кода:

procedure UnPackStream(var sSrc: TMemoryStream);
var
UnknownPtr: pointer;
NewSize: integer;
begin
sSrc.Position := 0;
try
  DeCompressBuf(sSrc.Memory, sSrc.Size, 0, UnknownPtr, NewSize);
  sSrc.clear;
  sSrc.Position := 0;
  sSrc.Write(UnknownPtr^, NewSize);
  sSrc.Position := 0;
finally
  FreeMem(UnknownPtr, NewSize);
end;
end;

Выдает подряд три ошибки: "error", access voilation, и под конец "Invalid stream operations". Я в шоке. Что делать?
P.S. в качестве sSrc передаю переменную input:


input:=tmemorystream.create;
input.Clear;
input.LoadFromFile("c:\file.gz");
UnPackStream(input);


Файл опять-таки существует, к нему есть доступ и т.п. (П.П.С. гзип и винрар его спокойн расшифровывают и шифруют обратно).


 
Anatoly Podgoretsky ©   (2007-01-08 02:56) [10]

> Ским  (08.01.2007 02:53:09)  [9]

Ну еще бы, освобождаешь не выделеную память и пытаешься работать с неинициализированым указателем.


 
Ским ©   (2007-01-08 02:59) [11]

О_о

1) вываливается во время обработки кода, который указан чуть выше моего первого сообщения (который у другого человкеа работает).

2) ладно, уберем .clear - реультат тот же... а указатель



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2007.02.25;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.044 c
2-1170782271
Novichok_new
2007-02-06 20:17
2007.02.25
Цикл for назад


3-1164974166
Patrick
2006-12-01 14:56
2007.02.25
Нетрадиционный параметр


15-1170235098
RustamK
2007-01-31 12:18
2007.02.25
Трансляция ТВ


2-1170477876
Garacio
2007-02-03 07:44
2007.02.25
найти 6 одинаковых чисел в строке


2-1170556818
Riply
2007-02-04 05:40
2007.02.25
Обращение к свойству класса после вызова Destroy.





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский