main.pas

一个曾经热门的网络游戏RO查看GRF工具的源码

      until not Assigned(Node);

      StatusBar1.SimpleText := IntToStr(FileList.SelectedCount) + ' files selected (' +
              FriendlySizeName(Size) + ')';
  end;
end;

procedure TForm1.FileListClick(Sender: TObject);
var
  FType, FName: String;
  Item: ^TGrfItem;

  Data: Pointer;
  Size: Cardinal;
  Error: TGrfError;

  TempDir, TempFile: array[0..MAX_PATH] of Char;
begin
  UpdateSelectionStatus;
  if (Grf = nil) or (FileList.SelectedCount <> 1) or (not PreviewBtn.Down) then
      Exit;

  Item := FileList.GetNodeData(FileList.GetNextSelected(FileList.RootNode));
  FType := UpperCase(ExtractFileExt(Grf.files[Item.i].Name));

  if (FType = '.TXT') or (FType = '.XML') then
  begin
      Data := grf_get(Grf, PChar(Grf.files[Item.i].Name), Size, Error);
      if Data = nil then
      begin
          MessageBox(Handle, grf_strerror(Error), 'Error', MB_ICONERROR);
          Exit;
      end;

      RichEdit1.Text := String(Data);
      NoteBook1.PageIndex := 0;

  end else if (FType = '.BMP') then
  begin
      GetTempPath(SizeOf(TempDir) - 1, @TempDir);
      GetTempFileName(TempDir, 'grf', 1, @TempFile);
      FName := TempFile + FType;

      if not grf_extract(Grf, PChar(Grf.files[Item.i].Name), PChar(FName), Error) then
      begin
          MessageBox(Handle, grf_strerror (Error), 'Error', MB_ICONERROR);
          Exit;
      end;

      try
          Image1.Picture.LoadFromFile(FName);
      except
          // Do nothing
      end;
      DeleteFile(FName);
      Notebook1.PageIndex := 1;

  end else
  begin
      RichEdit1.Clear;
      Notebook1.PageIndex := 0;
  end;
end;

procedure TForm1.SearchKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then
      SearchBtnClick(Sender);
end;

procedure TForm1.FileListKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  UpdateSelectionStatus;
  if (Key = VK_DOWN) or (Key = VK_UP) or (Key = VK_HOME) or (Key = VK_END)
    or (Key = VK_PRIOR) or (Key = VK_NEXT) then
      // We update the preview with a timer because right now,
      // the file list's item index hasn't changed yet
      Timer1.Enabled := True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Timer1.Enabled := False;
  FileListClick(Sender);
end;

procedure TForm1.AboutBtnClick(Sender: TObject);
begin
  AboutBox := TAboutBox.Create(nil);
  AboutBox.ShowModal;
  AboutBox.Free;
end;

procedure TForm1.IterateList(Sender: TBaseVirtualTree; Node: PVirtualNode; Data: Pointer; var Abort: Boolean);
var
  Files: TStringList;
  NData: ^TGrfItem;
begin
  Files := TStringList(Data);
  NData := FileList.GetNodeData(Node);
  if Grf.files[NData.i].TheType <> 2 then   // Do not extract folders
      Files.Add(Grf.files[NData.i].Name);
  Abort := False;
end;

procedure TForm1.ExtractBtnClick(Sender: TObject);
var
  Files: TStringList;
  Error: TGrfError;
  Info: TBrowseInfo;
  ItemList: PItemIDList;
  Dir: array[0..MAX_PATH] of Char;
const
  BIF_NEWDIALOGSTYLE = 64;
begin
  Files := TStringList.Create;
  Files.BeginUpdate;
  if FileList.SelectedCount = 0 then
      FileList.IterateSubtree(nil, IterateList, Files, [])
  else
      FileList.IterateSubtree(nil, IterateList, Files, [vsSelected]);
  Files.EndUpdate;


  if Files.Count = 1 then
  begin
      SaveDialog1.FileName := ExtractFileName(Files[0]);
      if SaveDialog1.Execute then
      begin
          if not grf_extract(Grf, PChar(Files[0]), PChar(SaveDialog1.FileName), Error) then
              MessageBox(Handle,
                  PChar('Unable to extract ' + ExtractFileName(Files[0]) + ':' + #13#10 + grf_strerror(Error)),
                  'Error', MB_ICONERROR)
          else
              StatusBar1.SimpleText := 'Successfully extracted ' + ExtractFileName(Files[0]);
      end;
      Files.Free;

  end else
  begin
      ZeroMemory(@Info, sizeof(TBrowseInfo));
      Info.hwndOwner := Handle;
      Info.ulFlags := BIF_EDITBOX or BIF_NEWDIALOGSTYLE;
      Info.lpszTitle := 'Select a folder to extract the files to.';
      ItemList := SHBrowseForFolder(Info);
      if not Assigned(ItemList) then Exit;

      if not SHGetPathFromIDList(ItemList, Dir) then
      begin
          FreeMemory(ItemList);
          Files.Free;
          Exit;
      end;
      FreeMemory(ItemList);

      StatusBar1.SimpleText := 'Extracting ' + IntToStr(Files.Count) + ' files...';
      Extractor := TExtractor.Create(True);
      Extractor.Files := Files;
      Extractor.Dir := Dir;
      Extractor.Grf := Grf;
      Extractor.FreeOnTerminate := True;
      ExtractWatcher.Enabled := True;
      ProgressBar1.Max := Files.Count;
      ProgressBar1.Position := 0;
      ExtractorPanel.Show;
      OpenBtn.Enabled := False;
      ExtractBtn.Enabled := False;
      Extractor.Resume;
  end;
end;

procedure TForm1.ExtractWatcherTimer(Sender: TObject);
begin
  if not Assigned(Extractor) then Exit;
  ProgressBar1.Position := Extractor.Current;
  StatusBar1.SimpleText := Format('Extracting (%.1f%%): %s',
        [Extractor.Current / Extractor.Max * 100.0,
        ExtractFileName(Extractor.CurrentFile)]);
end;

procedure TForm1.StopButtonClick(Sender: TObject);
begin
  Extractor.Stop := True;
  StopButton.Enabled := False;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if Assigned(Extractor) then begin
      Extractor.FreeOnTerminate := False;
      Extractor.Stop := True;
      Extractor.WaitFor;
      Extractor.Free;
  end;
  Application.ProcessMessages;
end;

procedure TForm1.FileListGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var
  Data: ^TGrfItem;
  Text: array[0..1024] of WideChar;
begin
  Data := FileList.GetNodeData(Node);
  if Column = 0 then
  begin
      if MultiByteToWideChar(51949, MB_PRECOMPOSED, Grf.files[Data.i].Name, -1, Text, SizeOf(Text) - 1) > 0 then
          CellText := Text
      else
          CellText := Grf.files[Data.i].Name;
  end
  else if Column = 1 then
      CellText := GetTypeName(Grf.files[Data.i].Name)
  else if Column = 2 then
      CellText := FriendlySizeName(Grf.files[Data.i].RealLen)
  else
      CellText := '';
end;

procedure TForm1.FileListDblClick(Sender: TObject);
begin
  if ExtractBtn.Enabled then
      ExtractBtnClick(Sender);
end;

procedure TForm1.FileListCompareNodes(Sender: TBaseVirtualTree; Node1,
  Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
  Data1, Data2: ^TGrfItem;
begin
  Data1 := FileList.GetNodeData(Node1);
  Data2 := FileList.GetNodeData(Node2);

  if Column = 0 then         // Name
      Result := CompareText(Grf.files[Data1.i].Name, Grf.files[Data2.i].Name)
  else if Column = 1 then    // Type
      Result := CompareText(GetTypeName(Grf.files[Data1.i].Name),
                            GetTypeName(Grf.files[Data2.i].Name))
  else if Column = 2 then    // Size
      Result := Grf.files[Data2.i].RealLen - Grf.files[Data1.i].RealLen
  else
      Result := 0;
  StatusBar1.SimpleText := IntToStr(Column);
end;

procedure TForm1.FileListHeaderClick(Sender: TVTHeader;
  Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if Column = FSortColumn then
  begin
     if FSortDirection = sdAscending then
         FSortDirection := sdDescending
     else
         FSortDirection := sdAscending;
  end else
  begin
      FSortColumn := Column;
      FSortDirection := sdAscending;
  end;
  FileList.Sort(nil, Column, FSortDirection);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  P: TPaintBox;
begin
  P := TPaintBox(Sender);
  P.Canvas.Pen.Color := clBtnHighlight;
  P.Canvas.MoveTo(4, 3);
  P.Canvas.LineTo(4, P.Height - 3);
  P.Canvas.Pen.Color := clBtnShadow;
  P.Canvas.MoveTo(3, 3);
  P.Canvas.LineTo(3, P.Height - 3);
end;

end.