unit kolPortalDatObject;
{ $DEFINE DATDEBUG}

interface

uses
  KOL, kolPortalDatConsts{, kolDXTDecompress};

type
  DWord = LongWord;

  ACBlock = packed record
    NextBlock : DWord;
    Data : Array[1..255] of DWord;
  end;

  ACFileEntry = packed record
    fID : DWord;
    fPos : DWord;
    fSize : DWord;
    fUnixTime : DWord;
    fRootOrigin : DWord;
  end;

  ACToDFileEntry = packed record
    fUnk1 : DWord;
    fID : DWord;
    fPos : DWord;
    fSize : DWord;
    fUnixTime : DWord;
    fUnk2 : DWord;
  end;

  PPortalDat = ^TPortalDat;
  TPortalDat = object(TObj)
  private
    fFileCount : DWord;
    fPortalDat : PStream;
    fPortalDatType : Integer;
    fSectorSize : DWord;
    fFileSize : DWord;
    fParsed : Boolean;
    fAbortAction: Boolean;
  {$IFDEF DATDEBUG}
    fDebugFile : PStream;
    fTotalFileCount : Integer;
    fTotalSize : LongWord;
    fTotalBlockCount : Integer;
    procedure DebugOut(const AText: String);
  {$ENDIF DATDEBUG}
  public
    WhileOpeningCallback: procedure of object;
    WhileReadingCallback: procedure of object;
    WhileWritingCallback: procedure of object;
    fFileList : array of ACFileEntry;
    fAC1ToDFileEntry : ACToDFileEntry;
    destructor Destroy; virtual;

    function Open(PortalDat: string; PDType: Integer): Integer;
    function GetErrorText(ErrorCode: Integer): String;

    function GetFileSize(FileID: DWord): LongWord;
    function GetGroupCount(FileType: Byte): LongWord;
    procedure GetFileIDs(FileType: Byte; var aFileList: TList);
    function ValidID(const FileID: LongWord): Boolean;

    function ExtractDirblock(FilePos: DWord; var aStream: PStream): Integer;
    function ExtractFile(FileID: DWord; var aStream: PStream): Integer;
    function InjectFile(aFileID: DWord; var aStream: PStream): Integer;

    // ac1 specific
    function ExtractUIImage(ImageID: DWord; var aBitmap: PBitmap): Integer;
    function InjectUIImage(aFileID: DWord; var aBitmap: PBitmap): Integer;
    function ACHash(Text: string; Seed: DWord): Dword;
    function ReadACString(Source: PStream): String;
    function NibbleString(Text: String): String;

    // AC2 specific
    function ac2ExtractBMP( aImageID: DWord; var aBitmap: PBitmap): Integer;
    function ac2ExtractImage( aImageID: DWord; var aStream: PStream): Integer;
    function ac2ExtractWAV( aSoundID: DWord; var aStream: PStream): Integer;
    function ac2ReadString( aStream: PStream; var aWideString: WideString ): Integer;
    function ac2StringFromToken( aStringTableID, aStringToken : DWord): WideString;

    property Parsed : Boolean read fParsed default false;
    property FileCount : DWord read fFileCount default 0;
    property PortalVer : Integer read fPortalDatType;
    property PDFileStream : PStream read fPortalDat;
    property AbortAction : Boolean read fAbortAction write fAbortAction;
  end;

  { Create }
  function NewPortalDat: PPortalDat;
  { Extra }
  function PortalDatType(PortalDat: String): Integer;
  function ValidPDFile(PortalDat: String): Boolean;
  function GetGroupIDText(GID: LongWord; PDType: Integer): String;
  function GetAC1Path: String;
  function GetAC2Path: String;

implementation

{ TPortalDat }

function TPortalDat.ACHash(Text: string; Seed: DWord): Dword;
var
  pos,
  tRes,
  tVal : DWord;
begin
  tRes := 0;
  for pos := 1 to Length(Text) do begin
    tRes := tRes shl 4;
    Inc(tRes,Ord(Text[pos]));
    if not boolean(tRes and $F0000000) then begin
      tVal := (tRes and $F0000000);
      tRes := tRes and $FFFFFFF;
      tRes := tRes xor (tVal shr 24);
    end;
  end;
  tRes := tRes mod Seed;
  ACHash := tRes;
end;

destructor TPortalDat.Destroy;
begin
  if fParsed then
    SetLength(fFileList,0);
  if fPortalDat <> nil then begin
    fPortalDat.Free;
    fPortalDat := nil;
  end;
{$IFDEF DATDEBUG}
  if fDebugFile <> nil then fDebugFile.Free;
{$ENDIF DATDEBUG}
  inherited;
end;

function TPortalDat.ExtractDirblock(FilePos: DWord; var aStream: PStream): Integer;
var
  bACBlock : ACBlock;
begin
  bACBlock.NextBlock := FilePos;
  while (bACBlock.NextBlock <> 0) and (aStream.Size < 2040) do begin
    fPortalDat.Seek( bACBlock.NextBlock, spBegin );
    fPortalDat.Read( bACBlock, fSectorSize );
    aStream.Write( bACBlock.Data, fSectorSize-4 );
  end;
  Result := pderrSuccess;
end;

function TPortalDat.ExtractFile(FileID: DWord; var aStream: PStream): Integer;
var
  cnt : Dword;
  IDExists : Boolean;
  bACBlock : ACBlock;
  BlockCount,
  BlockLeft,
  NextBlock : Dword;
begin
  Result := pderrSuccess;
  if fParsed = False then Result := pderrNotParsed;
  if aStream = nil then Result := pderrSourceNotInitialized;
  IDExists := False;
  for cnt := Low(fFileList) to High(fFileList) do begin
    if fFileList[cnt].fID = FileID then begin
      IDExists := true;
      Break;
    end;
  end;
  if IDExists = False then Result := pderrBadFileID;
  if Result <> pderrSuccess then Exit;

  BlockCount := fFileList[cnt].fSize div (fSectorSize-4);
  BlockLeft := fFileList[cnt].fSize mod (fSectorSize-4);
  NextBlock := fFileList[cnt].fPos;
  cnt := 0;
  while (cnt < BlockCount) do begin
    fPortalDat.Seek( NextBlock, spBegin );
    fPortalDat.Read( bACBlock, fSectorSize);
    AStream.Write( bACBlock.Data, (fSectorSize-4));
    NextBlock := bACBlock.NextBlock;
    Inc(cnt);
  end;
  fPortalDat.Seek( NextBlock, spBegin );
  fPortalDat.Read( bACBlock, fSectorSize);
  AStream.Write( bACBlock.Data, BlockLeft );
  Result := pderrSuccess;
end;

function TPortalDat.InjectFile(aFileID: DWord; var aStream: PStream): Integer;
var
  cnt : Dword;
  IDExists : Boolean;
  BlockCount,
  BlockLeft,
  NextBlock : Dword;
  Data : Array[1..255] of DWord;
begin
  Result := pderrSuccess;
  if fParsed = False then Result := pderrNotParsed;
  if aStream = nil then Result := pderrDestNotInitialized;
  IDExists := False;
  for cnt := Low(fFileList) to High(fFileList) do
    if fFileList[cnt].fID = aFileID then begin
      IDExists := true;
      Break;
    end;
  if IDExists = False then Result := pderrBadFileID;
  if fFileList[cnt].fSize <> aStream.Size then Result := pderrBadInjectSourceSize;
  if Result <> pderrSuccess then Exit;

  //
  BlockCount := fFileList[cnt].fSize div SizeOf(Data);
  BlockLeft := fFileList[cnt].fSize mod SizeOf(Data);
  NextBlock := fFileList[cnt].fPos;

  cnt := 0;
  while (cnt < BlockCount) do begin
    fPortalDat.Seek( NextBlock, spBegin );
    fPortalDat.Read( NextBlock, SizeOf(NextBlock) );
    aStream.Read( Data, SizeOf(Data) );
    fPortalDat.Write( Data, SizeOf(Data) );
    Inc(cnt);
  end;
  fPortalDat.Seek( NextBlock, spBegin );
  fPortalDat.Read( NextBlock, SizeOf(NextBlock) );
  AStream.Read( Data, BlockLeft );
  fPortalDat.Write( Data, BlockLeft );

  Result := pderrSuccess;
end;

function TPortalDat.ExtractUIImage(ImageID: DWord; var aBitmap: PBitmap): Integer;
type
  ltagRGBTRIPLE = packed record
    rgbtRed: Byte;
    rgbtGreen: Byte;
    rgbtBlue: Byte;
  end;
  pRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..16383] of ltagRGBTRIPLE;
var
  imgFile : PStream;
  iWidth,iHeight : DWord;
  y,x : Integer;
  Row : pRGBTripleArray;
  rSwap,bSwap : Byte;
begin
  if aBitmap = nil then begin Result := pderrSourceNotInitialized; Exit; end;
  if (ImageID < $06000000) or (ImageID > $060FFFFF) then begin
    Result := pderrInvalidImageFileID;
    Exit;
  end;

  if fPortalDatType <> 1 then begin Result := pderrBadPDVers; Exit; end;

  imgFile := NewMemoryStream;
  try
    Result := ExtractFile( ImageID, imgFile );
    if Result <> 0 then Exit;

    imgFile.Seek( 4, spBegin );
    imgFile.Read( iWidth, 4 );
    imgFile.Read( iHeight, 4 );
    aBitmap.Width := iWidth;
    aBitmap.Height := iHeight;
    aBitmap.PixelFormat := pf24bit;
    for y := 0 to (aBitmap.Height-1) do begin
      Row := aBitmap.Scanline[y];
      imgFile.Read(Row^,aBitmap.Width*3);
      for x := 0 to (aBitmap.Width-1) do begin
        rSwap := Row[x].rgbtRed;
        bSwap := Row[x].rgbtBlue;
        Row[x].rgbtRed := bSwap;
        Row[x].rgbtBlue := rSwap;
      end;
    end;
    aBitmap.Tag := 1;
    Result := pderrSuccess;
  finally
    imgFile.Free;
  end;
end;

function TPortalDat.InjectUIImage(aFileID: DWord; var aBitmap: PBitmap): Integer;
type
  ltagRGBTRIPLE = packed record
    rgbtRed: Byte;
    rgbtGreen: Byte;
    rgbtBlue: Byte;
  end;
  pRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..16383] of ltagRGBTRIPLE;
(*
var
  imgFile : PStream;
  iWidth,iHeight : DWord;
  y,x : Integer;
  Row : pRGBTripleArray;
  rSwap,bSwap : Byte;
*)
begin
  Result := pderrUnknown;
  if fParsed = False then begin Result := pderrNotParsed; Exit; end;
  if aBitmap = nil then begin Result := pderrSourceNotInitialized; Exit; end;
  if (aFileID < $06000000) or (aFileID > $060FFFFF) then begin Result := pderrInvalidImageFileID; Exit; end;
  //
end;

procedure TPortalDat.GetFileIDs(FileType: Byte; var aFileList: TList);
var
  fcnt : Integer;
begin
  for fcnt := Low(fFileList) to High(fFileList) do begin
    if (fFileList[fcnt].fID shr 24) = FileType then
      aFileList.Add( Ptr(fFileList[fcnt].fID) );
  end;
end;

function TPortalDat.GetFileSize(FileID: DWord): LongWord;
var
  cnt : Integer;
begin
  result := 0;
  for cnt := Low(fFileList) to High(fFileList) do begin
    if fFileList[cnt].fID = FileID then begin
      Result := fFileList[cnt].fSize;
      Break;
    end;
  end;
end;

function TPortalDat.NibbleString(Text: String): String;
var
  i           : LongWord;
  lBy         : Byte;
begin
  Result := '';
  If length(Text) > 0 then
  for i := 1 to Length(Text) do begin
    lBy := ord(Text[i]);
    if lBy > 0 then begin
      lBy := ((lBy and 15)*16) or ((lBy and $f0) shr 4);
      if (lBy > 31) and (lBy < 126) then
        Result := Result + Char(lBy);
    end;
  end;
end;

function TPortalDat.Open(PortalDat: string; PDType: Integer): Integer;
var
  rootdir,
  cnt, idx : DWord;
  DirRead,
  DirQueue : PList;
{$IFDEF DATDEBUG}
  SaveBlock,
{$ENDIF DATDEBUG}
  bACDirBlock : PStream;
  bDirRefs : Array[1..62] of DWord;
  bFileCount : DWord;
begin
  if ValidPDFile( PortalDat ) = False then begin
    Result := pderrInvalidPortalDat;
    Exit;
  end;

  if not (PDType in [pdverOne,pdverTwo,pdverThree]) then // 1 = AC1, 2 = AC2, 3 = AC1:TOD
    fPortalDatType := PortalDatType( PortalDat )
  else
    fPortalDatType := PDType;
  if fPortalDatType = 0 then begin
    Result := pderrUnknownPortalDat;
    Exit;
  end;
  {$IFDEF DATDEBUG}
  fTotalFileCount := 0;
  fTotalSize := 0;
  fTotalBlockCount := 0;
  DebugOut(PortalDat+' is from AC'+Int2Str(fPortalDatType));
  {$ENDIF DATDEBUG}

  fParsed := False;
  fPortalDat := NewReadFileStream( PortalDat );

  case fPortalDatType of
    1,2 : fPortalDat.Seek( $130, spBegin );
    3 : fPortalDat.Seek( $144, spBegin );
  end;
  fPortalDat.Read( fSectorSize, 4 );

  fFileSize := fPortalDat.Size;

  case fPortalDatType of
    1 : fPortalDat.Seek( AC1RootDir, spBegin );
    2 : fPortalDat.Seek( AC2RootDir, spBegin );
    3 : fPortalDat.Seek( AC3RootDir, spBegin );
  end;
  fPortalDat.Read( rootdir,4 );

  DirRead := NewList;
  DirQueue := NewList;
  fFileCount := 0;
  bACDirBlock := NewMemoryStream;
  try
    DirQueue.Add( Ptr(rootdir) );
    SetLength( fFileList, 0 );
    while (DirQueue.Count > 0) do begin
      if DirRead.IndexOf( Ptr(Dword(DirQueue.Items[0])) ) = -1 then begin
        DirRead.Add( Ptr(Dword(DirQueue.Items[0])) );

        bACDirBlock.Size := 0;
        ExtractDirBlock( Dword(DirQueue.Items[0]), bACDirBlock );
        bACDirBlock.Seek( 0, spBegin );

        if bACDirBlock.Size > 2040 then begin
{$IFDEF DATDEBUG}
          DebugOut('Bad dirblock located at: '+Int2Hex(Dword(DirQueue.Items[0]),8)+
                   ', size: '+Int2Str(bACDirBlock.Size)
          );
{$ENDIF DATDEBUG}
          // Ignore the fucker@$!
        end else begin
{$IFDEF DATDEBUG}

          if FileExists('x:\logs\root_'+Int2Hex(Dword(DirQueue.Items[0]),2)) then
          begin
            DebugOut('Dirblock already exists: '+Int2Hex(Dword(DirQueue.Items[0]),8));
          end else begin

            SaveBlock := NewWriteFileStream('x:\logs\root_'+Int2Hex(Dword(DirQueue.Items[0]),2));
            try
              Stream2Stream(SaveBlock,bACDirBlock,bACDirBlock.Size);
            finally
              SaveBlock.Free;
            end;
          end;

          Inc(fTotalBlockCount);
{$ENDIF DATDEBUG}
          bACDirBlock.Seek( 0, spBegin );
          bACDirBlock.Read( bDirRefs, SizeOf(bDirRefs) );
          for cnt := 1 to 62 do
            if (bDirRefs[cnt] > 0) and (bDirRefs[cnt] < fFileSize) and
               (bDirRefs[cnt] mod fSectorSize = 0) then
            begin
              if (DirRead.IndexOf(Ptr(bDirRefs[cnt])) = -1) then
                DirQueue.Add(Ptr(bDirRefs[cnt]));
            end else Break;

          bACDirBlock.Seek( 248, spBegin );
          bACDirBlock.Read( bFileCount, 4 );

          if (bFileCount > 0) and (bFileCount < 64) then
          begin
{$IFDEF DATDEBUG}
          Inc(fTotalFileCount,bFileCount);
{$ENDIF DATDEBUG}
            SetLength(fFileList,High(fFileList)+1+Integer(bFileCount));
            idx := High(fFileList)-Integer(bFileCount);
            for cnt := 1 to bFileCount do begin
              if (fPortalDatType in [pdverTwo]) then
              begin
                bACDirBlock.Read( fFileList[idx+cnt], 16 );
              end else
              if (fPortalDatType in [pdverThree]) then
              begin
                bACDirBlock.Read( fAC1ToDFileEntry, 24 );
                fFileList[idx+cnt].fID := fAC1ToDFileEntry.fID;
                fFileList[idx+cnt].fPos := fAC1ToDFileEntry.fPos;
                fFileList[idx+cnt].fSize := fAC1ToDFileEntry.fSize;
                fFileList[idx+cnt].fUnixTime := fAC1ToDFileEntry.fUnixTime;
              end else
              begin
                bACDirBlock.Read( fFileList[idx+cnt], 12 );
                fFileList[idx+cnt].fUnixtime := 0;
              end;
              if (fFileList[idx+cnt].fSize > fFileSize) then
              begin
                ShowMessage('Wtf!');
              end;
              fFileList[idx+cnt].fRootOrigin := Dword(DirQueue.Items[0]);
            end; // for cnt := 1 to bFileCount
{$IFDEF DATDEBUG}
            for cnt := 1 to bFileCount do
              Inc(fTotalSize,fFileList[idx+cnt].fSize);
{$ENDIF DATDEBUG}
          end else begin
{$IFDEF DATDEBUG}
            DebugOut('Bad filecount: '+Int2str(bFileCount)+
                     ', from: '+Int2Hex(Dword(DirQueue.Items[0]),8));
{$ENDIF DATDEBUG}
          end;

        end; // if bACDirBlock.Size > 2040
      end; // if DirRead.IndexOf( DirQueue.Items[0] ) = -1
      DirQueue.Delete(0);
      if @WhileOpeningCallback <> nil then WhileOpeningCallback;
      if fAbortAction then begin
        SetLength(fFileList,0);
        Result := pderrUnknown;
        Exit;
      end;
    end;
    fParsed := True;
    fFileCount := High(fFileList);
    Result := pderrSuccess;
{$IFDEF DATDEBUG}
    DebugOut('Total filecount was : '+Int2str(fTotalFileCount));
    DebugOut('Total blockcount was : '+Int2str(fTotalBlockCount));
    DebugOut('Total filesize was : '+Int2str(fTotalSize));
    DebugOut('Total blocksize was : '+Int2str(fTotalBlockCount*2040));
    DebugOut('Total size was : '+Int2str((fTotalBlockCount*2040)+fTotalSize));
{$ENDIF DATDEBUG}
  finally
    DirRead.Free;
    DirQueue.Free;
    bACDirBlock.Free;
  end;
end;

function TPortalDat.ReadACString(Source: PStream): String;
var
  strsize     : Word;
  strmod      : Integer;
  buffer      : PChar;
begin
  strsize := 0;
  Source.Read(strsize,2);
  strmod := strsize mod 4;
  case strmod of
    0 : Inc(strsize,2);
    1 : Inc(strsize);
    3 : Inc(strsize,3);
  end;
  SetLength(result,strsize);
  GetMem(buffer,strsize);
  Source.Read(buffer^,strsize);
  Result := buffer;
  FreeMem(buffer);
end;

function TPortalDat.GetErrorText(ErrorCode: Integer): String;
begin
  case ErrorCode of
    pderrSuccess : Result := 'Success!';
    pderrInvalidPortalDat : Result := 'Invalid portal.dat file.';
    pderrUnknownPortalDat : Result := 'Unknown portal.dat file.';
    pderrNotParsed : Result := 'Portal.dat hasn''t been parsed yet.';
    pderrBadFileID : Result := 'Bad fileid.';
    pderrBadPDVers : Result := 'Wrong portal.dat version.';
    pderrExtractFailed : Result := 'Unable to extract file.';
    pderrDestNotInitialized : Result := 'Destination isn''t initialized.';
    pderrSourceNotInitialized : Result := 'Source isn''t initialized.';
    pderrBadInjectSourceSize : Result := 'Inject filesize mismatch.';
    pderrInvalidImageFileID : Result := 'Invalid UI file ID.';
  else
    Result := 'Unknown error.';
  end;
end;

function TPortalDat.GetGroupCount(FileType: Byte): LongWord;
var
  fcnt : LongWord;
begin
  Result := 0;
  for fcnt := Low(fFileList) to High(fFileList) do begin
    if (fFileList[fcnt].fID shr 24) = FileType then
      Inc(Result);
  end;
end;

function TPortalDat.ac2ExtractBMP(aImageID: DWord; var aBitmap: PBitmap): Integer;
type
  pRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..16383] of array[1..3] of Byte;
  pRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = array[0..16383] of array[1..4] of Byte;
var
  imgFile : PStream;
  iUnk,
  iWidth,
  iHeight,
  iType,
  iSize : DWord;
  y : Integer;
  Row3 : pRGBTripleArray;
  Row4 : pRGBQuadArray;

begin
  if aBitmap = nil then begin Result := pderrSourceNotInitialized; Exit; end;
  if fPortalDatType <> 2 then begin Result := pderrBadPDVers; Exit; end;
  if (aImageID < $41000000) or (aImageID > $41FFFFFF) then begin
    Result := pderrInvalidImageFileID;
    Exit;
  end;

  imgFile := NewMemoryStream;
  try
    Result := ExtractFile( aImageID, imgFile );
    if Result <> 0 then Exit;

    imgFile.Seek( 4, spBegin );
    imgFile.Read( iUnk, 4 );
    imgFile.Read( iWidth, 4 );
    imgFile.Read( iHeight, 4 );
    imgFile.Read( iType, 4 );
    imgFile.Read( iSize, 4 );

    if (iType in [$14..$15]) then begin
      aBitmap.Tag := iType;
      aBitmap.Width := iWidth;
      aBitmap.Height := iHeight;

      if iType = $15 then begin
        aBitmap.PixelFormat := pf32bit;
        for y := 0 to (aBitmap.Height-1) do begin
          Row4 := aBitmap.Scanline[y];
          imgFile.Read(Row4^,aBitmap.Width*4);
        end;
      end;

      if iType = $14 then begin
        aBitmap.PixelFormat := pf24bit;
        for y := 0 to (aBitmap.Height-1) do begin
          Row3 := aBitmap.Scanline[y];
          imgFile.Read(Row3^,aBitmap.Width*3);
        end;
      end;
      
    end;
    Result := pderrSuccess;
  finally
    imgFile.Free;
  end;
end;

function TPortalDat.ac2ExtractImage(aImageID: DWord; var aStream: PStream): Integer;
type
  pRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..16383] of array[1..3] of Byte;
  pRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = array[0..16383] of array[1..4] of Byte;
var
  imgFile : PStream;
  iBitmap : PBitmap;
  iUnk,
  iWidth,
  iHeight,
  iType,
  iSize : DWord;
  y : Integer;
  Row3 : pRGBTripleArray;
  Row4 : pRGBQuadArray;
begin
  if aStream = nil then begin Result := pderrSourceNotInitialized; Exit; end;
  if fPortalDatType <> 2 then begin Result := pderrBadPDVers; Exit; end;
  if (aImageID < $41000000) or (aImageID > $41FFFFFF) then begin
    Result := pderrInvalidImageFileID;
    Exit;
  end;

  imgFile := NewMemoryStream;
  try
    Result := ExtractFile( aImageID, imgFile );
    if Result <> 0 then Exit;

    imgFile.Seek( 4, spBegin );
    imgFile.Read( iUnk, 4 );
    imgFile.Read( iWidth, 4 );
    imgFile.Read( iHeight, 4 );
    imgFile.Read( iType, 4 );
    imgFile.Read( iSize, 4 );

    if (iType in [$14..$15]) then begin
      iBitmap := NewBitmap( 0, 0 );
      try
        aStream.Tag := iType;
        iBitmap.Width := iWidth;
        iBitmap.Height := iHeight;

        if iType = $15 then begin
          iBitmap.PixelFormat := pf32bit;
          for y := 0 to (iBitmap.Height-1) do begin
            Row4 := iBitmap.Scanline[y];
            imgFile.Read(Row4^,iBitmap.Width*4);
          end;
        end;

        if iType = $14 then begin
          iBitmap.PixelFormat := pf24bit;
          for y := 0 to (iBitmap.Height-1) do begin
            Row3 := iBitmap.Scanline[y];
            imgFile.Read(Row3^,iBitmap.Width*3);
          end;
        end;

        iBitmap.SaveToStream( aStream );
      finally
        iBitmap.Free;
      end;
    end;

    if (iType = $1F4) then begin
      aStream.Tag := iType;
      Stream2Stream( aStream, imgFile, iSize );
    end;

    Result := pderrSuccess;
  finally
    imgFile.Free;
  end;
end;

function TPortalDat.ac2ExtractWAV(aSoundID: DWord; var aStream: PStream): Integer;
begin
  if aStream = nil then begin Result := pderrSourceNotInitialized; Exit; end;
  if fPortalDatType <> 2 then begin Result := pderrBadPDVers; Exit; end;
  if (aSoundID < $0C000000) or (aSoundID > $0CFFFFFF) then begin
    Result := pderrInvalidImageFileID;
    Exit;
  end;
  Result := pderrSuccess;
end;

function TPortalDat.ac2ReadString(aStream: PStream; var aWideString: WideString): Integer;
var
  bufSize,
  strSize : Word;
  strBuffer,
  strPointer : PChar;
  //
  subCount,
  mainCount : Integer;
  strDWord : DWord;
  //
  i : Integer;
  lBy : Byte;
  d : Word;
  KeyTable : TAC2KeyTable;
begin
  if aStream = nil then begin Result := pderrSourceNotInitialized; Exit; end;
  result := pderrUnknown;
  aStream.Read( strSize, 2 );
  if strSize > $FFF then Exit;

  KeyTable := StringKeyTable;
  bufSize := (strSize*2)+2;
  
  GetMem( strBuffer, bufSize );
  try
    aStream.Read( strBuffer^, strSize*2 );

    if ((strSize*2) mod 4) = 0 then aStream.Read(d,2);

    mainCount := 0; subCount := 0;
    strPointer := strBuffer;
    repeat
      Move( strPointer^, strDWord, 4);
      strDWord := KeyTable[subCount] xor strDWord;
      Move( strDWord, strPointer^, 4);
      Inc( strPointer, 4 );
      Inc( subCount ); Inc( mainCount );
      if subCount = 16 then subCount := 0;
    until mainCount >= (strSize div 2);

    strPointer := strBuffer;
    for i := 0 to ((strSize*2)-1) do begin
      Move( strPointer^, lBy, 1);
      lBy := (lBy shr 4) or (lBy shl 4);
      Move( lBy, strPointer^, 1);
      Inc( strPointer, 1);
    end;

    SetLength( aWideString, StrSize );
    strPointer := strBuffer;
    for i := 1 to Length(aWideString) do begin
      Move( strPointer^, d, 2 );
      aWideString[i] := WideChar(d);
      Inc( strPointer, 2);
    end;

    Result := pderrSuccess;
  finally
    FreeMem( strBuffer );
  end;
end;

function TPortalDat.ac2StringFromToken(aStringTableID, aStringToken: DWord): WideString;
var
  aStream: PStream;
  aCnt, bCnt, cCnt: LongWord;
  aWideStr: WideString;
  //
  stLineCount,
  stToken,
  stReference: LongWord;
  stSubCount,
  stType,
  stwUnk2,
  stwUnk3: Word;
  stUnk4: LongWord;
  cnt : Integer;
  IDExists : Boolean;
begin
  Result := '!';
  if fParsed = False then Result := '';
  IDExists := False;
  for cnt := Low(fFileList) to High(fFileList) do begin
    if LongWord( fFileList[cnt].fID ) = LongWord( aStringTableID ) then begin
      IDExists := True;
      Break;
    end;
  end;
  if IDExists = False then Result := '';
  if Result = '' then Exit;
  Result := '';

  aStream := NewMemoryStream;
  try
    ExtractFile( aStringTableID, aStream );
    aStream.Seek( $10, spBegin );

    aStream.Read( stLineCount, 4 );
    for aCnt := 1 to stLineCount do begin
      aStream.Read( stToken,4 );
      aStream.Read( stReference,4 );
      if (stReference > 0) then begin
      end else begin
        aStream.Read(stSubCount,2);
        aStream.Read(stType,2);
        if stSubCount > $F then Exit;
        if stType = 0 then Exit;
        bCnt := 1;
        while bCnt <= stSubCount do begin
          ac2ReadString( aStream, aWideStr );
          aWideStr := Trim( aWideStr );
          if stToken = aStringToken then begin
            Result := aWideStr;
            Break;
          end;
          if (bCnt <> stSubCount) then begin
            stwUnk2 := 0; stwUnk3 := 0;
            aStream.Read( stwUnk2, 2 );
            aStream.Read( stwUnk3, 2 );
          end else begin
            aStream.Read( stwUnk2, 2 );
            for cCnt := 1 to stwUnk2 do begin
              aStream.Read( stUnk4, 4 );
            end;
            aStream.Read( stwUnk3, 2 );
          end;
          Inc( bCnt );
        end;
      end;
      if aStream.Position >= aStream.Size then Exit;
    end;
  finally
    aStream.Free;
  end;
end;

function TPortalDat.ValidID(const FileID: LongWord): Boolean;
var
  cnt : Integer;
begin
  result := False;
  for cnt := Low(fFileList) to High(fFileList) do
    if fFileList[cnt].fID = FileID then
    begin
      result := True;
      Break;
    end;
end;

{ Creates }

function NewPortalDat: PPortalDat;
begin
  New( Result, Create );
  with Result^ do begin
    fAbortAction := False;
    fParsed := False;
    fFileCount := 0;
    fPortalDat := nil;
    WhileOpeningCallback := nil;
    WhileReadingCallback := nil;
    WhileWritingCallback := nil;
  end;
end;

{ Extra functions }

function PortalDatType(PortalDat: String): Integer;
var
  aFile : PStream;
  aCheck : DWord;
begin
  Result := 0;
  If FileExists( PortalDat ) = False then Exit;
  aFile := NewReadFileStream( PortalDat );
  try
    // First try for AC1:ToD
    aFile.Seek( $140, spBegin );
    aFile.Read( aCheck, SizeOf(aCheck) );
    if (aCheck = pdverID) then
    begin
      Result := pdverThree;
    end else
    begin
      aFile.Seek( $170, spBegin );
      aFile.Read( aCheck, SizeOf(aCheck) );
      if (aCheck <> 0) then
        Result := pdverTwo
      else
        Result := pdverOne;
    end;
  finally
    aFile.Free;
  end;
end;

function ValidPDFile(PortalDat: String): Boolean;
var
  aFile : PStream;
  aCheck : DWord;
begin
  Result := False;
  If FileExists( PortalDat ) = False then Exit;
  aFile := NewReadFileStream( PortalDat );
  try
    aFile.Seek( $12C, spBegin );
    aFile.Read( aCheck, SizeOf(aCheck) );
    Result := (aCheck = pdverID);
    // For AC1:ToD
    if not Result then
    begin
      aFile.Seek( $140, spBegin );
      aFile.Read( aCheck, SizeOf(aCheck) );
      Result := (aCheck = pdverID);
    end;
  finally
    aFile.Free;
  end;
end;

function GetGroupIDText(GID: LongWord; PDType: Integer): String;
begin
  Result := '';
  case PDType of
    pdverOne : Result := AC1FileGroupName(GID);
    pdverTwo : Result := AC2FileGroupName(GID);
  end;
end;

function GetAC1Path: String;
var
  AC1Reg : LongWord;
begin
  AC1Reg := RegKeyOpenRead(DWORD($80000002), 'SOFTWARE\Microsoft\Microsoft Games\Asheron''s Call\2.0');
  try
    result := RegKeyGetStr(AC1Reg, 'InstallationDirectory');
  finally
    RegKeyClose(AC1Reg);
  end;
end;

function GetAC2Path: String;
var
  AC2Reg : LongWord;
begin
  AC2Reg := RegKeyOpenRead(DWORD($80000002), 'SOFTWARE\Microsoft\Microsoft Games\Asheron''s Call\1.00');
  try
    result := RegKeyGetStr(AC2Reg, 'EXE Path');
  finally
    RegKeyClose(AC2Reg);
  end;
end;

{$IFDEF DATDEBUG}
procedure TPortalDat.DebugOut(const AText: String);
begin
  if fDebugFile = nil then
  begin
    fDebugFile := NewWriteFileStream('x:\logs\datobj_debug.txt');
  end;
  fDebugFile.WriteStr(AText+#13#10);
end;
{$ENDIF DATDEBUG}

end.