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

Вниз

Сжатие в памяти   Найти похожие ветки 

← →
_sMile   (2003-03-25 12:00) [0]

Кто-нибудь сжимал какие-либо данные в памяти? Поделитесь опытом.

---

← →
Jel   (2003-03-25 12:15) [1]

Не совсем понятно в чем вопрос. Если в выборе библиотеки для сжатия - попробуй Zlib.

---

← →
_sMile   (2003-03-25 12:18) [2]

А ты её юзал?
Вообще-то нужно сжимать битмап, а затем его потоком отправить через сокетное соединение

---

← →
Polevi   (2003-03-25 13:09) [3]

ZLib.CompressBuf

---

← →
Digitman   (2003-03-25 15:24) [4]

как один из возможных вариантов :


uses ...., ZLib, ...

{ IDataBlock }

IDataBlock = interface(IUnknown)
["{71B66900-D436-11D5-82C2-444553540000}"]
function GetBytesReserved: Integer; stdcall;
function GetMemory: Pointer; stdcall;
function GetSize: Integer; stdcall;
procedure SetSize(Value: Integer); stdcall;
function GetStream: TStream; stdcall;
function GetSignature: Integer; stdcall;
procedure SetSignature(Value: Integer); stdcall;
function GetContext: Integer; stdcall;
procedure SetContext(Value: Integer); stdcall;
procedure Clear; stdcall;
function Write(const Buffer; Count: Integer): Integer; stdcall;
function Read(var Buffer; Count: Integer): Integer; stdcall;
procedure IgnoreStream; stdcall;
function InitData(Data: Pointer; DataLen: Integer; CheckLen: Boolean): Integer; stdcall;
property BytesReserved: Integer read GetBytesReserved;
property Memory: Pointer read GetMemory;
property Signature: Integer read GetSignature write SetSignature;
property Context: Integer read GetContext write SetContext;
property Size: Integer read GetSize write SetSize;
property Stream: TStream read GetStream;
end;

{ TDataBlock }

const
DataBlockHdrSize = 12; // Signature(DWord) + Context(DWord) + DataSize(DWord)

type

TDataBlock = class(TInterfacedObject, IDataBlock)
private
FStream: TMemoryStream;
FReadPos: Integer;
FWritePos: Integer;
FIgnoreStream: Boolean;
protected
{ IDataBlock }
function GetBytesReserved: Integer; stdcall;
function GetMemory: Pointer; stdcall;
function GetSize: Integer; stdcall;
procedure SetSize(Value: Integer); stdcall;
function GetStream: TStream; stdcall;
function GetSignature: Integer; stdcall;
procedure SetSignature(Value: Integer); stdcall;
function GetContext: Integer; stdcall;
procedure SetContext(Value: Integer); stdcall;
procedure Clear; stdcall;
function Write(const Buffer; Count: Integer): Integer; stdcall;
function Read(var Buffer; Count: Integer): Integer; stdcall;
procedure IgnoreStream; stdcall;
function InitData(Data: Pointer; DataLen: Integer; CheckLen: Boolean): Integer; stdcall;
property BytesReserved: Integer read GetBytesReserved;
property Memory: Pointer read GetMemory;
property Signature: Integer read GetSignature write SetSignature;
property Context: Integer read GetContext write SetContext;
property Size: Integer read GetSize write SetSize;
property Stream: TStream read GetStream;
public
constructor Create;
destructor Destroy; override;
end;

IDataCompressor = interface
["{1DE0B201-8270-11D4-BF6B-006094ACED50}"]
function Get_Enabled: WordBool; stdcall;
procedure Set_Enabled(const Value: WordBool); stdcall;
function Get_CompressionLevel: TCompressionLevel; stdcall;
procedure Set_CompressionLevel(const Value: TCompressionLevel); stdcall;
procedure CompressData(const Data: IDataBlock); stdcall;
procedure DecompressData(const Data: IDataBlock); stdcall;
property Enabled: WordBool read Get_Enabled write Set_Enabled;
property CompressionLevel: TCompressionLevel read Get_CompressionLevel write Set_CompressionLevel;
end;

{ TACSDataCompressor }

TACSDataCompressor = class(TInterfacedObject, IDataCompressor)
private
FInStream: TMemoryStream;
FOutStream: TMemoryStream;
FEnabled: Boolean;
FCompressionLevel: TCompressionLevel;
protected
function Get_Enabled: WordBool; stdcall;
procedure Set_Enabled(const Value: WordBool); stdcall;
function Get_CompressionLevel: TCompressionLevel; stdcall;
procedure Set_CompressionLevel(const Value: TCompressionLevel); stdcall;
procedure CompressData(const Data: IDataBlock); virtual; stdcall;
procedure DecompressData(const Data: IDataBlock); virtual; stdcall;
public
constructor Create(CompressionLevel: TCompressionLevel = clFastest);
destructor Destroy; override;
end;



---

← →
Digitman   (2003-03-25 15:26) [5]


constructor TACSDataCompressor.Create(CompressionLevel: TCompressionLevel = clFastest);
begin
inherited Create;
FCompressionLevel:= CompressionLevel;
FInStream:= TMemoryStream.Create;
FOutStream:= TMemoryStream.Create;
FEnabled:= True;
end;

destructor TACSDataCompressor.Destroy;
begin
FInStream.Free;
FOutStream.Free;
inherited Destroy;
end;

function TACSDataCompressor.Get_Enabled: WordBool;
begin
Result:= FEnabled;
end;

procedure TACSDataCompressor.Set_Enabled(const Value: WordBool);
begin
FEnabled:= Value;
end;

function TACSDataCompressor.Get_CompressionLevel: TCompressionLevel;
begin
Result:= FCompressionLevel;
end;

procedure TACSDataCompressor.Set_CompressionLevel(const Value: TCompressionLevel);
begin
FCompressionLevel:= Value;
end;

procedure TACSDataCompressor.CompressData(const Data: IDataBlock);
var
ZStream: TCompressionStream;
UncomprSize: Integer;
begin
if Assigned(Data) and (Data.Size > 0) then
try
FInStream.Write(Pointer(Integer(Data.Memory) + Data.BytesReserved)^, Data.Size);
UncomprSize:= FInStream.Size;
try
ZStream := TCompressionStream.Create(FCompressionLevel, FOutStream);
try
ZStream.CopyFrom(FInStream, 0);
finally
ZStream.Free;
end;
Data.Clear;
Data.Write(UncomprSize, SizeOf(UncomprSize));
Data.Write(FOutStream.Memory^, FOutStream.Size);
finally
FOutStream.Clear;
end;
finally
FInStream.Clear;
end;
end;

procedure TACSDataCompressor.DecompressData(const Data: IDataBlock);
var
ZStream: TDecompressionStream;
UncomprSize: Integer;
p: Pointer;
begin
if Assigned(Data) and (Data.Size > 0) then begin
p:= Pointer(Integer(Data.Memory) + Data.BytesReserved);
UncomprSize:= PInteger(p)^;
if UncomprSize <> 0 then
try
Inc(Integer(p), SizeOf(UncomprSize));
FInStream.Write(p^, Data.Size - SizeOf(UncomprSize));
FInStream.Position:= 0;
try
ZStream:= TDecompressionStream.Create(FInStream);
try
FOutStream.CopyFrom(ZStream, UncomprSize);
finally
ZStream.Free;
end;
Data.Clear;
Data.Write(FOutStream.Memory^, UncomprSize);
finally
FOutStream.Clear;
end;
finally
FInStream.Clear;
end;
end;
end;


---

← →
Digitman   (2003-03-25 15:27) [6]


{ TDataBlock }

constructor TDataBlock.Create;
begin
inherited Create;
FIgnoreStream := False;
FStream := TMemoryStream.Create;
Clear;
Context := 0;
end;

destructor TDataBlock.Destroy;
begin
if not FIgnoreStream then
FStream.Free;
inherited Destroy;
end;

{ TDataBlock.IDataBlock }

procedure TDataBlock.Clear;
begin
FStream.Size := DataBlockHdrSize;
FReadPos := DataBlockHdrSize;
FWritePos := DataBlockHdrSize;
end;

function TDataBlock.GetBytesReserved: Integer;
begin
Result := DataBlockHdrSize;
end;

function TDataBlock.GetContext: Integer;
begin
FStream.Position := 4;
FStream.Read(Result, SizeOf(Result));
end;

function TDataBlock.GetMemory: Pointer;
var
DataSize: Integer;
begin
FStream.Position := SizeOf(Signature) + SizeOf(Context);
DataSize := FStream.Size - DataBlockHdrSize;
FStream.Write(DataSize, SizeOf(DataSize));
Result := FStream.Memory;
end;

function TDataBlock.GetSignature: Integer;
begin
FStream.Position := 0;
FStream.Read(Result, SizeOf(Result));
end;

function TDataBlock.GetSize: Integer;
begin
Result := FStream.Size - DataBlockHdrSize;
end;

function TDataBlock.GetStream: TStream;
var
DataSize: Integer;
begin
FStream.Position := SizeOf(Signature) + SizeOf(Context);
DataSize := FStream.Size - DataBlockHdrSize;
FStream.Write(DataSize, SizeOf(DataSize));
FStream.Position := 0;
Result := FStream;
end;

procedure TDataBlock.IgnoreStream;
begin
FIgnoreStream := True;
end;

function TDataBlock.InitData(Data: Pointer; DataLen: Integer; CheckLen: Boolean): Integer;
var
Sig: Integer;
Cntxt: Integer;
P: Pointer;
begin
P := Data;
if DataLen < DataBlockHdrSize then
raise Exception.CreateRes(@SInvalidDataPacket);
Sig := PInteger(P)^;
if (Sig and CallSig <> CallSig) and
(Sig and ResultSig <> ResultSig) then
raise Exception.CreateRes(@SInvalidDataPacket);
Signature := Sig;
P := Pointer(Integer(Data) + SizeOf(Sig));
Context := PInteger(P)^;
P := Pointer(Integer(Data) + SizeOf(Cntxt));
Result := PInteger(P)^;
P := Pointer(Integer(P) + SizeOf(Result));
if CheckLen then begin
if (Result <> DataLen - DataBlockHdrSize) then
raise Exception.CreateRes(@SInvalidDataPacket);
Size := Result;
if Result > 0 then
Write(P^, Result);
end else begin
Size := DataLen - DataBlockHdrSize;
if Size > 0 then
Write(P^, Size);
end;
end;

function TDataBlock.Read(var Buffer; Count: Integer): Integer;
begin
FStream.Position := FReadPos;
Result := FStream.Read(Buffer, Count);
FReadPos := FStream.Position;
end;

procedure TDataBlock.SetContext(Value: Integer);
begin
FStream.Position := 4;
FStream.Write(Value, SizeOf(Value));
end;

procedure TDataBlock.SetSignature(Value: Integer);
begin
FStream.Position := 0;
FStream.Write(Value, SizeOf(Value));
end;

procedure TDataBlock.SetSize(Value: Integer);
begin
FStream.Size := Value + DataBlockHdrSize;
end;

function TDataBlock.Write(const Buffer; Count: Integer): Integer;
begin
FStream.Position := FWritePos;
Result := FStream.Write(Buffer, Count);
FWritePos := FStream.Position;
end;


---

← →
REA   (2003-03-26 09:54) [7]

Тут недавно пробегал компонент Stream с компрессией

---

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

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

Наверх

Память: 0.48 MB
Время: 0.008 c