⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 PAK PAK PAK PAK PAK PAK PAK PAK
💻 PAS
字号:
unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, ToolWin, ComCtrls, ExtCtrls, Menus, ImgList;

const
  IMG_ROOT_CLOSE = 0;
  IMG_ROOT_OPEN  = 1;
  IMG_FOLDER_CLOSE = 2;
  IMG_FOLDER_OPEN = 3;
  IMG_FILE = 4;
  IMG_PARENT = 5;
  
type
  TmainForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Edit1: TMenuItem;
    Open1: TMenuItem;
    N1: TMenuItem;
    Save1: TMenuItem;
    SaveAs1: TMenuItem;
    N2: TMenuItem;
    Exit1: TMenuItem;
    Undo1: TMenuItem;
    OpenDialog1: TOpenDialog;
    DirView: TTreeView;
    Splitter1: TSplitter;
    FileView: TListView;
    Statusbar: TStatusBar;
    Images: TImageList;
    ContextMenu: TPopupMenu;
    Properties1: TMenuItem;
    Extract1: TMenuItem;
    N3: TMenuItem;
    procedure Open1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DirViewChange(Sender: TObject; Node: TTreeNode);
    procedure FileViewClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Properties1Click(Sender: TObject);
    procedure Extract1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    Filename: String;
    Totalfiles: integer;
    Lumps: TStringList;
    BaseNode: TTreeNode;
    Procedure LoadPakFile(fname:string);
    function isDuplicateName(Node: TTreeNode; sNewName:string): TTreeNode;
    procedure updateFiles;
    procedure addRootNode(title:string);
    function getFullPath(node: TTreeNode): string;
    function findLumpEntry(node: TTreeNode): integer;
    function writeLumpEntry(index: integer; path: string): boolean;
  public
  end;

var
  mainForm: TmainForm;

implementation

uses progress;

{$R *.DFM}
function CustomSortProc(  Node1,  Node2 : TTreeNode;  Data : integer  ) : integer; stdcall;
      {Inline function returns true if Node is a File}
   function IsAFile(  Node : TTreeNode  ) : boolean;
   begin
      Result := ((Node.ImageIndex = IMG_FILE));
   end;

      {Inline function returns true if Node is a Folder}
   function IsAFolder(  Node : TTreeNode  ) : boolean;
   begin
      Result := ((Node.ImageIndex = IMG_FOLDER_CLOSE) or
                 (Node.ImageIndex = IMG_FOLDER_OPEN));
   end;


begin
      {Files before folders}
   if(   IsAFile(  Node1  ) and IsAFolder(  Node2  )   ) then
   begin
      Result := 1;
      Exit;
   end;

      {Folder after file}
   if(   IsAFolder(  Node1  ) and IsAFile(  Node2  )   ) then
   begin
      Result := -1;
      Exit;
   end;

      {Nodes are of the same type, so do a normat alpha sort}
   Result := AnsiStrIComp(  PChar(Node1.Text), PChar(Node2.Text)  );
end;

function TMainForm.IsDuplicateName(  Node : TTreeNode;
                           sNewName : string
                         ) : TTreeNode;
var
   TestNode : TTreeNode;
begin
   if(  Node = nil  ) then
   begin
      Result := nil;
      Exit;
   end;

      {Test all previous siblings}
   TestNode := Node;

   if (CompareText( TestNode.text, sNewname) = 0 ) then
     begin
        Result := testNode;
        Exit;
     end;


   repeat
         {Get next}
      TestNode := TestNode.GetPrevSibling;

      if(  TestNode <> nil  ) then
            {Is this a duplicate}
         if(   CompareText(  TestNode.Text,  sNewName  ) = 0   ) then
         begin
            Result := testNode;
            Exit;
         end;
   until (TestNode = nil);


      {Test all next siblings}
   TestNode := Node;
   repeat
         {Get next}
      TestNode := TestNode.GetNextSibling;

      if(  TestNode <> nil  ) then
            {Is this a duplicate}
         if(   CompareText(  TestNode.Text,  sNewName  ) = 0   ) then
         begin
            Result := testNode;
            Exit;
         end;
   until (TestNode = nil);

   Result := nil;
end;


procedure TmainForm.Open1Click(Sender: TObject);
begin
     if OpenDialog1.Execute then
        Begin
             LoadPakFile(OpenDialog1.FileName);
        end;
end;

procedure TmainForm.FormCreate(Sender: TObject);
begin
  AddRootNode('(file/open...)');
  Lumps := TStringList.create;
  lumps.Clear;
end;

procedure TmainForm.LoadPakFile(fname:string);
var dirofs, dirlen, i, filepos, filelen: integer;
    nameString: string;
    name: array[0..56] of char;
    pakFile: TFileStream;
    s: array[0..3] of char;
    testNode,parentNode: TTreeNode;
    str,str2: string;
begin

     // directory = new DataInputStream(new FileInputStream(pakName));
     pakFile := TFileStream.create(fname, fmOpenread or fmShareExclusive);
	// read the header
    s := '';

    pakFile.read(s, 4);

    if string(s)<>'PACK' then
       begin
         showMessage('File is no PAK file');
         exit;
       end;

    progressForm.show;
    progressForm.updateValues(0);

    FileName := fname;
    mainForm.Caption := 'PAK Browser - '+Filename;
    lumps.Clear;
    DirView.items.Clear;
    AddRootNode(FileName);

    pakFile.read(dirOfs,4);
    pakFile.read(dirLen,4);

    totalFiles := dirLen div 64;

    pakFile.seek(dirofs, soFromBeginning);

    progressForm.initValues(totalFiles*2);

    for i := 0 to totalFiles-1 do
      begin
        pakFile.read(name,56);
        pakFile.read(filePos,4);
        pakFile.read(fileLen,4);
        nameString := string(name);
        lumps.Add(nameString+':'+inttoStr(filepos)+'-'+inttostr(fileLen));
        progressForm.updateValues(i);
      end;

    pakFile.free;
    
    i :=0;
    for i:= 0 to totalFiles -1 do
      begin
        progressForm.updateValues(i+TotalFiles);
        ParentNode := basenode;
        testNode := nil;
        str := copy(lumps[i],0,pos(':',lumps[i])-1);

        while (pos('/',str)>0) do
          begin
            str2 := copy(str,0,pos('/',str)-1);
            str := copy(str,pos('/',str)+1,1000);
            testNode := isDuplicateName(parentNode.getFirstChild,str2);
            if testNode=nil then
               begin
                 parentNode:=DirView.items.AddChild(ParentNode,str2);
                 parentNode.imageIndex := IMG_FOLDER_CLOSE;
                 parentNode.selectedIndex := IMG_FOLDER_OPEN;
               end
            else parentNode:=testNode;
          end;

        testNode:=DirView.Items.AddChild(ParentNode, str);
        testNode.imageIndex := IMG_FILE;
        testNode.selectedIndex := IMG_FILE;
      end;
  baseNode.selected:=true;
  baseNode.getFirstChild.makeVisible;

  DirView.CustomSort(  @CustomSortProc,  0  );

  progressForm.Close;

end;


procedure TmainForm.updateFiles;
var node,child: TTreeNode;
begin
  FileView.Items.BeginUpdate;

  node := DirView.Selected;
  fileview.items.Clear;

  if (node=nil) then exit;
  if (node.Parent <> nil) then
    with fileview.items.add do
      begin
        Caption := '..';
        imageIndex := IMG_PARENT;
        data := node.Parent.itemid;
      end;
  child := node.getFirstChild;
  while (child<>nil) do
    begin
      with FileView.Items.add do
        begin
          Caption := child.text;
          ImageIndex := Child.ImageIndex;
          Data := child.ItemId;
        end;
      child := node.getNextChild(child);
    end;
  FileView.CustomSort(@CustomSortProc, 0);
  FileView.items.EndUpdate;
end;

procedure TmainForm.DirViewChange(Sender: TObject; Node: TTreeNode);
begin
  UpdateFiles;
end;

procedure TmainForm.addRootNode(title: string);
begin
    BaseNode := DirView.Items.AddChild(nil, title);
    BaseNode.ImageIndex := IMG_ROOT_CLOSE;
    BaseNode.selectedIndex := IMG_ROOT_OPEN;
end;

procedure TmainForm.FileViewClick(Sender: TObject);
var LinkNode: TTreeNode;
begin
      {Make sure there is a selection}
   if(  FileView.Selected = nil  ) then
      Exit;

      {Find the node in the TreeView that corresponds to
        this ListView Item}
   LinkNode := DirView.Items.GetNode(  FileView.Selected.Data  );

      {If the node was found, select it}
   if(  LinkNode <> nil  ) then
      LinkNode.Selected := true;

end;


procedure TmainForm.Exit1Click(Sender: TObject);
begin
  close;
end;

function TmainForm.getFullPath(node: TTreeNode): string;
var s: string;
    first: boolean;
begin
  s:='';
  first := true;
  while (node.Parent <> nil) do
    begin
      if first then
        s:=node.Text+s
      else
        s:=node.Text+'/'+s;
      node :=node.Parent;
      first:=false;
    end;
  result:=s;
end;

procedure TmainForm.Properties1Click(Sender: TObject);
var i: integer;
begin
  i := findLumpEntry(DirView.Items.GetNode(  FileView.Selected.Data  ));
  if (i>-1) then
    ShowMessage('Full path: '+lumps[i]) else
    ShowMessage('No entry in PAK file!');
end;

function TmainForm.findLumpEntry(node: TTreeNode): integer;
var i: integer;
  s: string;
begin
  if (node=nil) or (node.ImageIndex <>IMG_FILE) then
    begin
      result := -1;
      exit;
    end;

  s := getFullPath(node);

  for i:=0 to totalFiles-1 do
      if (pos(s, lumps[i]) <>0 ) then
        begin
          result := i;
          exit;
        end;

  result := -1;
end;

function TmainForm.writeLumpEntry(index: integer; path: string): boolean;
var s: string;
  ofs, len: integer;
  i1,i2,i: integer;
  pakFile: TFileStream;
  outFile: file;
  buffer: array[0..99] of char;
begin
  if (index<0) or (index>=totalFiles) then
    begin
      result := false;
      exit;
    end;

  s := lumps[index];
  i1 := pos(':',s);
  i2 := pos('-',s);
  ofs := strtoInt(copy(s,i1+1,i2-i1-1));
  len := strtoInt(copy(s,i2+1,100));
  s := copy(s, 0, i1-1);
  while (pos('/',s)>0) do
    s := copy(s,pos('/',s)+1,1000);

//  showMessage('File:   '+s+#13#10+'FileLen: '+inttostr(len)+#13#10+'FileOfs: '+inttostr(ofs));

  pakFile := TFileStream.create(fileName, fmOpenRead or fmShareExclusive);
  pakFile.Seek(ofs, soFrombeginning);

  system.assign(outFile, path+'\'+s);
  system.Rewrite(outFile);

  progressForm.Show;
  progressForm.initValues(len div 100);

  for i:=0 to (len div 100) do
    begin
      pakFile.read(buffer, 100);
      system.blockwrite(outFile,buffer, 100);
      progressForm.updateValues(i);
    end;

  i2 := len - (len div 100) * 100;
  pakFile.read(buffer, i2);
  system.blockwrite(outFile,buffer, i2);

  pakFile.free;
  system.close(outfile);

  progressForm.Close;

end;

procedure TmainForm.Extract1Click(Sender: TObject);
begin
  writeLumpEntry(findLumpEntry(DirView.Items.GetNode(FileView.Selected.Data)), 'c:\temp');
end;

procedure TmainForm.FormActivate(Sender: TObject);
begin
  if paramcount > 0 then LoadPakFile(paramstr(1));
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -