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

Вниз

Проблема с распаковкой архива   Найти похожие ветки 

← →
Vayrus   (2008-10-13 00:01) [0]

Доброго времени суток уважаемые.
Следующие строчки кода предназначены для склейки/разбивки файлов:

unit SJS;

interface

uses
Windows, FS, Classes, SAPIF, dialogs,messages;

const
 Signature = "SLA!";
 Author    = "Vayrus";
 Version  = "1.0";

type
 TArcHead = packed record
   Sign  : array[0..3] of char;
   Vers  : String[4];
   Auth  : array[0..11] of char;
   Comm  : String;
 end;

type
 TFileHead = packed record
   FN    : ShortString;//Oieuei oae
   FSize : Longint;
 end;

Type
TActionFuntion = function(InStream, OutStream: TStream): Boolean;
TOperationCallBack = procedure(CurFile: String; OverallMax, OverallPosition: Integer);

var
STOP: Boolean = False;

procedure JoinToOne(Files: TStrings; const FileName: String; ActFunc :TActionFuntion; Progress: TOperationCallBack);
procedure SplitToDir(const FileName, DestDirectory: String; ActFunc :TActionFuntion; Progress: TOperationCallBack);

implementation

function GetFilesSize(InFiles: TStrings): Integer;
var
I : Integer;
begin
RESULT := 0;
For I  := 0 To InFiles.Count - 1 do
begin
RESULT := RESULT + _GetFileSize(InFiles[I]);
ProcessMessages;
end;
end;

procedure JoinToOne(Files: TStrings; const FileName: String; ActFunc :TActionFuntion; Progress: TOperationCallBack);
var
InFile, OutFile : TFileStream;
Tmp            : TMemoryStream;
I              : Integer;
AllSize, CurPos : Integer;
ArcHead        : TArcHead;
FileHead        : TFileHead;
begin
STOP    := False;
CurPos  := 0;
if Files.Count = 0 then EXIT;//
AllSize := GetFilesSize(Files) - SizeOf(TArcHead);//
OutFile := TFileStream.Create(FileName, fmCreate);
try
with ArcHead do
begin
Sign    := Signature;
Vers    := Version;
Auth    := Author;
Comm    := "oano";
end;
OutFile.Write(ArcHead, SizeOf(TArcHead));
for I := 0 to Files.Count - 1 do
begin
InFile  := TFileStream.Create(Files[I], fmOpenRead);
try
Tmp    := TMemoryStream.Create;
try
if not ActFunc(InFile, Tmp) then
begin
OutFile.Free;
InFile.Free;
Tmp.Free;
EXIT;
end;
with FileHead do
begin
FN      := ExtractFileName(Files[I]);
FSize  := Tmp.Size;
end;
Outfile.Write(FileHead, SizeOf(TFileHead));
OutFile.CopyFrom(Tmp, 0);
//
CurPos  := CurPos + InFile.Size + SizeOf(TFileHead);//
Progress(Files[I], AllSize, CurPos);
//
finally
InFile.Free;
end;
finally
Tmp.Free;
end;
if STOP then BREAK;
ProcessMessages;
end;
finally
OutFile.Free;
end;
if STOP then DeleteFile(PChar(FileName));//
end;

procedure SplitToDir(const FileName, DestDirectory: String; ActFunc :TActionFuntion; Progress: TOperationCallBack);
var
Dest            : String;
InFile, OutFile : TFilestream;
Tmp            : TMemoryStream;
AllSize, CurPos : Integer;
ArcHead        : TArcHead;
FileHead        : TFileHead;
begin
STOP    := False;//
CurPos  := 0;//
if not DirectoryExists(DestDirectory) then EXIT;//
Dest    := IncludeTrailingPathDelimiter(DestDirectory);//
InFile  := TFileStream.Create(FileName, fmOpenRead);
try
AllSize := InFile.Size - SizeOf(TArcHead);//
//InFile.Seek(0, soFromBeginning);
InFile.Read(ArcHead, SizeOf(TArcHead));
if ArcHead.Sign <> Signature then
if MessageBox(0, "Oi?iao oaeea ia iiaaa??eaaaony, ?aniaeiaaou i?eioaeoaeuii?", "Ioeaea", MB_YESNO or MB_ICONERROR) <> IDYES then
begin
InFile.Free;
EXIT;
end;
while InFile.Position <> InFile.Size do
begin
InFile.Read(FileHead, SizeOf(TFileHead));
OutFile := TFileStream.Create(Dest + FileHead.FN, fmCreate);
try
Tmp    := TMemoryStream.Create;
try
Tmp.CopyFrom(InFile, FileHead.FSize);
if not ActFunc(Tmp, OutFile) then
begin
InFile.Free;
OutFile.Free;
Tmp.Free;
EXIT;
end;
//OutFile.CopyFrom(Tmp2, Tmp2.Size);
//
CurPos  := CurPos + FileHead.FSize + SizeOf(TFileHead);//
Progress(Dest + FileHead.FN, AllSize, CurPos);
//
finally
OutFile.Free;
end;
finally
Tmp.Free;
end;
if STOP then BREAK;
ProcessMessages;
end;
finally
InFile.Free;
end;
end;

end.

Подскажите, пожалуйста, правильный код распаковки. Упаковка отрабатывает хорошо, но вот не пойму почему распаковка не работает (вылетает ошибув чтения потока).

← →
Германн ©   (2008-10-13 00:24) [1]

Comm  : String;
Какая нафиг длинная строка в записи?

← →
KilkennyCat ©   (2008-10-13 00:38) [2]


> Германн ©   (13.10.08 00:24) [1]

теоретически можно.

← →
Германн ©   (2008-10-13 00:49) [3]


> KilkennyCat ©   (13.10.08 00:38) [2]
>
>
> > Германн ©   (13.10.08 00:24) [1]
>
> теоретически можно.
>

Что можно? Вот это можно:

> InFile.Read(ArcHead, SizeOf(TArcHead));

?

← →
KilkennyCat ©   (2008-10-13 01:27) [4]

в данном случае - нет.

← →
Германн ©   (2008-10-13 01:38) [5]


> KilkennyCat ©   (13.10.08 01:27) [4]
>
> в данном случае - нет.
>

Ну и я о том же. Но автор молчит. Смущает то, что все прочие строковые элементы записей явно обозначены как короткие строки. То ли очепятка при переносе кода на форум, то ли собственные изменения надыбанного где-то кода без ясного понимания.
P.S. Судя по интерфейсному юзесу, скорее второе :)

← →
KilkennyCat ©   (2008-10-13 01:45) [6]


> скорее второе

плюс еще почему-то разномастное
>  TArcHead = packed record
>    Sign  : array[0..3] of char;
>    Vers  : String[4];
>    Auth  : array[0..11] of char;
>    Comm  : String;

и несовпадение размеров с

> const
>  Signature = "SLA!";
>  Author    = "Vayrus";
>  Version  = "1.0";

что в дальнейшем тож может вызвать проблемы.

← →
Германн ©   (2008-10-13 01:59) [7]


> KilkennyCat ©   (13.10.08 01:45) [6]


> и несовпадение размеров с
>
> > const
> >  Signature = "SLA!";
> >  Author    = "Vayrus";
> >  Version  = "1.0";
>
> что в дальнейшем тож может вызвать проблемы.
>

Не. Это не вызовет проблем. Ведь в случае короткой строки в записи будет присутствовать явно нулевой символ короткой строки. И несовпадение размеров может быть только при превышении.

← →
KilkennyCat ©   (2008-10-13 02:20) [8]

Все зависит от дальнейшего решения.

← →
Германн ©   (2008-10-13 02:26) [9]


> KilkennyCat ©   (13.10.08 02:20) [8]
>
> Все зависит от дальнейшего решения.
>

Автор задал вопрос. Ему ответили. Без его участия считаю топик мёртвым.

← →
Vayrus   (2008-10-13 12:19) [10]

Спасибо за участие, код мой, в архивации и описании типов не силен, проблему решил - нехватало одной строчки (Tmp.Seek(0, soFromBeginning)), вот полный код:

procedure SplitToDir(const FileName, DestDirectory: String; ActFunc :TActionFuntion; Progress: TOperationCallBack);
var
Dest        : String;
InFile, OutFile : TFilestream;
AllSize, CurPos : Integer;
ArcHead:TArcHead;
FileHead:TFileHead;
Tmp:TMemoryStream;
begin
STOP    := False;//
CurPos  := 0;//
if not DirectoryExists(DestDirectory) then EXIT;//
Dest    := IncludeTrailingPathDelimiter(DestDirectory);//
InFile  := TFileStream.Create(FileName, fmOpenRead);
try
AllSize := InFile.Size - SizeOf(TArcHead);//
InFile.Read(ArcHead,sizeof(TArcHead));
if ArcHead.Sign <> Signature then
if MessageBox(0, "Формат файла не поддерживается, распаковать принудительно?", "Ошибка", MB_YESNO or MB_ICONERROR) <> IDYES then EXIT;
while InFile.Position <> InFile.Size do //!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
begin
InFile.Read(FileHead,sizeof(TFileHead));
OutFile := TFileStream.Create(Dest+FileHead.FN, fmCreate);
//
Tmp:=TMemoryStream.Create;
try
Tmp.CopyFrom(InFile, FileHead.FSize);
Tmp.Seek(0, soFromBeginning);//Обязательно
if not ActFunc(Tmp, OutFile) then
begin
InFile.Free;
OutFile.Free;
Tmp.Free;
EXIT;
end;
//
CurPos  := CurPos + FileHead.FSize + SizeOf(TFileHead);//
Progress(Dest + FileHead.FN, AllSize, CurPos);
//
OutFile.Free;
finally
Tmp.Free;
end;
ProcessMessages;
end;
finally
InFile.Free;
end;
end;

Раз уж я неправильно описал типы, то представьте мне правильный вариант.

← →
Vayrus   (2008-10-13 12:30) [11]

Как я понял, описание типов должно иметь примерно следующий вид:

type
TArcHead = packed record
  Sign  : String[4];
  Vers  : String[3];
  Auth  : String[12];
  Comm  : String[60];
end;

type
TFileHead = packed record
  FN    : ShortString;//Oieuei oae
  FSize : Longint;
end;

← →
Vayrus   (2008-10-13 12:42) [12]

Вот окончательный мой вариант:

type
 TArcHead = packed record
   Sign  : String[4];
   Vers  : String[4];
   Auth  : String[12];
   Comm  : String[100];
 end;

type
 TFileHead = packed record
   FN    : String[100];//Только так
   FSize : Longint;
 end;

← →
KilkennyCat ©   (2008-10-13 12:43) [13]


> FN    : String[100];//Только так

почему только так? ShortString тоже имеет фиксированный размер.

← →
Vayrus   (2008-10-13 13:39) [14]


> почему только так? ShortString тоже имеет фиксированный
> размер.


Нет, это лично пометка для себя, старая, забыл убрать, не обращайте на это внимания.

← →
Ega23 ©   (2008-10-13 13:46) [15]


> while InFile.Position <> InFile.Size do


Строго меньше.

← →
Vayrus   (2008-10-13 13:46) [16]

Теперь, надеюсь, правильно:

type
TArcHead = packed record
  Sign  : String[4];
  Vers  : String[4];
  Auth  : String[12];
  Comm  : ShortString;
end;

type
TFileHead = packed record
  FN    : ShortString;
  FSize : Longint;
end;

А как увеличить отводимую под комментарий строку и можно ли использовать WideString для комментария и имен файлов ?

← →
Vayrus   (2008-10-13 13:47) [17]


> Строго меньше.


Учту, спасибо.

← →
Ega23 ©   (2008-10-13 14:00) [18]


> А как увеличить отводимую под комментарий строку и можно
> ли использовать WideString для комментария и имен файлов
> ?


Использовать стринг можно. Но аккуратно. Что-то типа:

type
 TBlockHeader = packed record
   BlockID : Integer;
   BlockSize : Integer;
 end;

А дальше всё тупо. Есть сущность "Комментарий". Заводим на неё в некоем "реестре" константу с кодом её блока. Например - cComment = $1F00;
Теперь, когда надо строку записать, причём именно как комментарий -

procedure StreamWriteString(Stream : TStream; const Value : string;
   const BlockID : Cardinal);
var
 BlockSize : Cardinal;
begin
 BlockSize := Length(Value);
 Stream.WriteBuffer(BlockID, 4);
 Stream.WriteBuffer(BlockSize, 4);
 Stream.WriteBuffer(PChar(Value)^, BlockSize);
end;

← →
Vayrus   (2008-10-13 14:48) [19]


> Использовать стринг можно. Но аккуратно. Что-то типа


Если Я Вас правильно понял, то получается примерно следующее:

unit SJS;

interface

uses
Windows, FS, Classes, SAPIF, dialogs,messages;

const
 Signature = "SLA!";
 Author    = "Vayrus";
 Version   = "1.0";
 CommID    = $1F00;

type
 TArcHead = packed record
   Sign  : String[4];
   Vers  : String[4];
   Auth  : String[12];
//    Comm  : ShortString;
 end;

type
 TFileHead = packed record
   FN    : ShortString;
   FSize : Longint;
 end;

type
TBlockHeader = packed record
  BlockID : Integer;
  BlockSize : Integer;
end;

Type
TActionFuntion = function(InStream, OutStream: TStream): Boolean;
TOperationCallBack = procedure(CurFile: String; OverallMax, OverallPosition: Integer);

var
STOP: Boolean = False;

procedure JoinToOne(Files: TStrings; const FileName: String; ActFunc :TActionFuntion; Progress: TOperationCallBack);
procedure SplitToDir(const FileName, DestDirectory: String; ActFunc :TActionFuntion; Progress: TOperationCallBack);

implementation

procedure StreamWriteString(Stream : TStream; const Value : String;
  const BlockID : Cardinal);
var
BlockSize : Cardinal;
begin
BlockSize := Length(Value);
Stream.WriteBuffer(BlockID, 4);
Stream.WriteBuffer(BlockSize, 4);
Stream.WriteBuffer(PChar(Value)^, BlockSize);
end;

function StreamReadString(Stream : TStream;
  const BlockID, BlockSize : Cardinal): String;
var
M: TStringStream;
begin
M      := TStringStream.Create("");
try
M.CopyFrom(Stream, BlockSize);
RESULT := M.DataString;
finally
M.Free;
end;
end;

function GetFilesSize(InFiles: TStrings): Integer;
var
I : Integer;
begin
RESULT := 0;
For I  := 0 To InFiles.Count - 1 do
begin
RESULT := RESULT + _GetFileSize(InFiles[I]);
ProcessMessages;
end;
end;

procedure JoinToOne(Files: TStrings; const FileName: String; ActFunc :TActionFuntion; Progress: TOperationCallBack);
var
InFile, OutFile : TFileStream;
Tmp             : TMemoryStream;
I               : Integer;
AllSize, CurPos : Integer;
ArcHead         : TArcHead;
FileHead        : TFileHead;
begin
STOP    := False;
CurPos  := 0;
if Files.Count = 0 then EXIT;//
AllSize := GetFilesSize(Files) - SizeOf(TArcHead);//
OutFile := TFileStream.Create(FileName, fmCreate);
try
with ArcHead do
begin
Sign    := Signature;
Vers    := Version;
Auth    := Author;
//Comm    := "&#242;&#229;&#241;&#242;";
end;
OutFile.Write(ArcHead, SizeOf(TArcHead));
//
StreamWriteString(OutFile,
WideString("&#205;&#224;&#247;&#224;&#235;&#238; &#209;&#242;&#240;&#238;&#234;&#232; -> ... -> &#202;&#238;&#237;&#229;&#246; &#209;&#242;&#240;&#238;&#234;&#232;"),
CommID);
//
for I := 0 to Files.Count - 1 do
begin
InFile  := TFileStream.Create(Files[I], fmOpenRead);
try
Tmp     := TMemoryStream.Create;
try
if not ActFunc(InFile, Tmp) then
begin
OutFile.Free;
InFile.Free;
Tmp.Free;
EXIT;
end;
with FileHead do
begin
FN      := ExtractFileName(Files[I]);
FSize   := Tmp.Size;
end;
Outfile.Write(FileHead, SizeOf(TFileHead));
OutFile.CopyFrom(Tmp, 0);
//
CurPos  := CurPos + InFile.Size + SizeOf(TFileHead);//
Progress(Files[I], AllSize, CurPos);
//
finally
Tmp.Free;
end;
finally
InFile.Free;
end;
if STOP then BREAK;
ProcessMessages;
end;
finally
OutFile.Free;
end;
if STOP then DeleteFile(PChar(FileName));//
end;

procedure SplitToDir(const FileName, DestDirectory: String; ActFunc :TActionFuntion; Progress: TOperationCallBack);
var
Dest        : String;
InFile, OutFile : TFilestream;
AllSize, CurPos : Integer;
ArcHead:TArcHead;
FileHead:TFileHead;
Tmp:TMemoryStream;
BlockHead:TBlockHeader;
begin
STOP    := False;//
CurPos  := 0;//
if not DirectoryExists(DestDirectory) then EXIT;//
Dest    := IncludeTrailingPathDelimiter(DestDirectory);//
InFile  := TFileStream.Create(FileName, fmOpenRead);
try
AllSize := InFile.Size - SizeOf(TArcHead);//
InFile.Read(ArcHead,sizeof(TArcHead));
if ArcHead.Sign <> Signature then
if MessageBox(0, "&#212;&#238;&#240;&#236;&#224;&#242; &#244;&#224;&#233;&#235;&#224; &#237;&#229; &#239;&#238;&#228;&#228;&#229;&#240;&#230;&#232;&#226;&#224;&#229;&#242;&#241;&# 255;, &#240;&#224;&#241;&#239;&#224;&#234;&#238;&#226;&#224;&#242;&#252; &#239;&#240;&#232;&#237;&#243;&#228;&#232;&#242;&#229;&#235;&#252;&#237;&#238;?" , "&#206;&#248;&#232;&#225;&#234;&#224;", MB_YESNO or MB_ICONERROR) <> IDYES then EXIT;
//
InFile.Read(BlockHead, SizeOf(TBlockHeader));
ShowMessage(StreamReadString(InFile, BlockHead.BlockID, BlockHead.BlockSize));
//
while InFile.Position < InFile.Size do //!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
begin
InFile.Read(FileHead,sizeof(TFileHead));
OutFile := TFileStream.Create(Dest+FileHead.FN, fmCreate);
//
Tmp:=TMemoryStream.Create;
try
Tmp.CopyFrom(InFile, FileHead.FSize);
Tmp.Seek(0, soFromBeginning);//&#206;&#225;&#255;&#231;&#224;&#242;&#229;&#235;&#252;&#237;&#238;
if not ActFunc(Tmp, OutFile) then
begin
InFile.Free;
OutFile.Free;
Tmp.Free;
EXIT;
end;
//
CurPos  := CurPos + FileHead.FSize + SizeOf(TFileHead);//
Progress(Dest + FileHead.FN, AllSize, CurPos);
//
OutFile.Free;
finally
Tmp.Free;
end;
ProcessMessages;
end;
finally
InFile.Free;
end;
end;

end.


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

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

Наверх





Память: 0.54 MB
Время: 0.006 c
3-1209540771
IgorBet
2008-04-30 11:32
2008.11.23
Вопросы надежности при частом создании/ удалении таблиц

2-1223738086
Виктор008
2008-10-11 19:14
2008.11.23
вопрос по Delphi 2009

15-1222070588
DillerXX
2008-09-22 12:03
2008.11.23
Требуется помощь телепатов высокого уровня

15-1222233440
Slider007
2008-09-24 09:17
2008.11.23
С днем рождения ! 24 сентября 2008 среда

2-1223881796
DJones
2008-10-13 11:09
2008.11.23
Проблема с доступом к private-членам класса




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
Английский Французский Немецкий Итальянский Португальский Русский Испанский