Перейти к содержимому


Внимание!

Это форум по извлечению ресурсов из игр: музыки, звуков, текстур, 3D-моделей...
Перед поиском ответов на форуме, рекомендуется ознакомиться с основным сайтом EXTRACTOR.ru!
[ Прочтите внимательно - правила создания тем и ответа в них ]
Все вопросы по запуску игр задавайте в другом месте: Установка и запуск игр.


Фотография

Звездное наследие

Автор Hi-jack , Jan 31 2006 22:32

  • Авторизуйтесь для ответа в теме
В теме одно сообщение

#1 Hi-jack

Hi-jack

    Рядовой

  • Пользователи
  • 1 сообщений

Отправлено 31 January 2006 - 22:32

Взял за исходник Ezd2all Spose с вашего сайта. Вообще буду теперь ее использовать как шаблон wink.gif , а то самому-то лень было написать.

Код
program bpk2all;

{$APPTYPE CONSOLE}

uses
Windows, SysUtils, Classes, Controls, StdCtrls, FileCtrl, ExtCtrls, ComCtrls;

Type
FileH = record
name:string;
sz,sm:integer;
end;

var
Header:boolean;
fs:TfileStream;
size,csize,sm:integer;
b:char;
s:string;
m:Tmemorystream;
i,junk:integer;
junkbuff: array [0..255] of char;
gg:array of FileH;
endoffset:integer;

procedure extract(name:string;x,z:integer);

procedure clnm;
var g:byte;
begin
g:=length(extractfilepath(name));
if g>0 then
name:=copy(name,g+1,length(name)-g);
end;

function ons(s:string):string;
begin
result:=copy(s,2,length(s)-1);
end;

function cname(s:string):string;
var g:byte;
begin
for g:=length(s) downto 1 do
if name[g]='/' then
name[g]:='\';
result:=name;
end;

begin
name:=cname(name);
clnm;
writeln('Extracting: '+name);
createdir('archive\'+ons(extractfileext(name)));
fs.Position:=x;
m:=tmemorystream.Create;
m.CopyFrom(fs,z);
m.Position:=0;
m.SaveToFile('archive\'+ons(extractfileext(name))+'\'+name);
M.Free;
end;

begin
Header:=True;
if (ParamCount<1) or (ParamCount>1) then
 begin
 writeln('Usage: bpk2all.exe game[1..4].bpk');
 Exit;
 end;
if not(FileExists(ParamStr(1))) then exit;
fs:=Tfilestream.Create( ParamStr(1),fmOpenRead);
createdir('archive');
fs.Position:=fs.Position+16;
endoffset:=fs.Size;
while (fs.Position<endoffset) and (Header) do
begin
s:='';
setlength(gg,high(gg)+2);
b:=' ';
repeat
fs.read(b,sizeof(b));
if ord(b)<>0 then
s:=s+b;
until  ord(b)=0;
gg[high(gg)].name:=s;
fs.Read(junkbuff[0], 111 - Length(s));
fs.Read(sm,sizeof(sm));
gg[high(gg)].sm:=sm;
fs.Read(size,sizeof(size));
gg[high(gg)].sz:=size;
fs.Read(junk,sizeof(junk));
fs.Read(csize,sizeof(csize));
if csize<>size then Header:=False;
if Header then writeln('File found: '+s);
end;
for i:=0 to high(gg)-1 do
extract(gg[i].name,gg[i].sm,gg[i].sz);
fs.Free;
writeln('All done! Press Return to exit.');
readln;
end.


PS. Если модератор мне даст права на создание тем в разделе "Новые программы на сайте" и заливку файло, то залью бинарник не в таком сыром виде конечно, доработаю чуток. Хотя я так понял, что проект заморожен. А так, хочу добавить ключей немного, хотя бы чтобы выдиралось не все, а опрдеенные типы файлов. Только Ogg, к примеру. А то game2.bpk, где музик, 600 Мег весит а музону там, ну максимум на 200 Meg...

#2 -=CHE@TER=-

-=CHE@TER=-

    Полковник

  • Администраторы
  • 971 сообщений
  • Пол:Мужчина

Отправлено 03 February 2006 - 20:15

Hi-jack!
Молодец!
Во! Открытые исходники на Delphi - уважаю.
Особенно не вникал в программу, так как уже сплю, но кое-что изменил - так, мне кажется, выглядит лучше (протести, может я где косяки добавил):
Код
Program bpk2all;
{$APPTYPE CONSOLE}

Uses Classes, SysUtils;

Type
    FileH = Record
        Name: String;
      Sz, Sm: Integer;
    End;

Var
            Header: Boolean;
                Fs: TFileStream;
   Size, CSize, Sm: Integer;
                 B: Char;
                 S: String;
                 M: TMemoryStream;
           I, Junk: Integer;
          JunkBuff: Array[0..255] Of Char;
                gg: Array Of FileH;
         EndOffset: Integer;

Procedure Extract(Name: String; X,Z: Integer);

Procedure clnm;
Var g: Byte;
Begin
 g:=Length(ExtractFilePath(Name));
 if g>0 then
 Name:=Copy(Name, g + 1, Length(Name) - g);
End;

Function ons(S: String): String;
Begin
 Result:=Copy(S, 2, Length(S) - 1);
End;

Function CName(S: String): String;
Var g:byte;
Begin
 For g:=Length(S) Downto 1 Do
   If name[g]='/' Then Name[g]:='\';
 Result:=Name;
End;

Begin
 Name:=CName(Name);
 clnm;
 WriteLn('Extracting: ' + Name);
 CreateDir('archive\' + ons(ExtractFileExt(Name)));
 fs.Position:=X;
 M:=TMemoryStream.Create;
 M.CopyFrom(fs, z);
 M.Position:=0;
 M.SaveToFile('archive\' + ons(ExtractFileExt(Name))+'\' + Name);
 M.Free;
End;

Begin
 Header:=True;
 If ParamCount<>1 Then
   Begin
     WriteLn('Usage: bpk2all.exe game[1..4].bpk');
     Exit;
   End;
 If Not FileExists(ParamStr(1)) Then
   Begin
     WriteLn('Input file not found.');
     Exit;
   End;
 fs:=TFileStream.Create(ParamStr(1), fmOpenRead);
 CreateDir('archive');
 fs.Position:=fs.Position + 16;
 EndOffset:=fs.Size;
 While (fs.Position<EndOffset) And (Header) Do
   Begin
     S:='';
     SetLength(gg, High(gg) + 2);
     b:=' ';
     Repeat
       fs.read(b,sizeof(b));
       If Ord(b)<>0 Then s:=s + b;
     Until Ord(b) = 0;
     gg[high(gg)].Name:=s;
     fs.Read(junkbuff[0], 111 - Length(s));
     fs.Read(sm, SizeOf(sm));
     gg[High(gg)].sm:=sm;
     fs.Read(size, SizeOf(Size));
     gg[High(gg)].sz:=Size;
     fs.Read(junk, sizeof(Junk));
     fs.Read(csize, sizeof(CSize));
     If csize<>size Then Header:=False;
     If Header Then WriteLn('File found: ' + s);
   End;
 For I:=0 To High(gg) - 1 Do
   Extract(gg[I].Name, gg[I].sm, gg[I].sz);
 fs.Free;
 WriteLn('All done! Press Return to exit.');
 ReadLn;
End.

Обратно в Программы


  1. Форум EXTRACTOR.ru
  2. → Extractor
  3. → Программы
  4. Privacy Policy