Browse Source

The proxy source I need to reference.

Steve Thielemann 5 years ago
parent
commit
73803f2082
3 changed files with 2600 additions and 0 deletions
  1. 220 0
      1_Port.ts
  2. 1343 0
      Database.pas
  3. 1037 0
      Process.pas

+ 220 - 0
1_Port.ts

@@ -0,0 +1,220 @@
+# Copyright (C) 2005  Remco Mulder
+# 
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+# 
+# For source notes please refer to Notes.txt
+# For license terms please refer to GPL.txt.
+# 
+# These files should be stored in the root of the compression you 
+# received this source in.
+
+# TWX Script Pack 1: Port pair trading script
+# Author           : Xide
+# Description      : Trades between two sectors with ports, buying and
+#                    selling products between them.
+#                    Haggles with a variable markup/markdown.
+#                    First docking is at the CURRENT sector of the player.
+# Trigger Point    : Sector command prompt
+# Warnings         : Ports must have enough products on board to make
+#                    this script worthwhile.  Ideally trading should stop
+#                    once a port hits below 20%.  This script assumes
+#                    there are no one-way warps between ports and that
+#                    they are adjacent to eachother.  Be
+#                    sure there are no obstructions in either sector.
+# Other            : I wouldn't try learning the script language here,
+#                    this script is quite complex and basically goes all
+#                    over the damn place :)
+
+# check if we can run it from here
+cutText CURRENTLINE $location 1 12
+
+if ($location <> "Command [TL=")
+  clientMessage "This script must be run from the command prompt"
+  halt
+end
+
+logging off
+
+# show script banner
+echo "**" ANSI_3 "     --" ANSI_11 "===| " ANSI_15 "Port Pair Trading v2.00" ANSI_11 " |===" ANSI_3 "--**"
+echo ANSI_7 "No registration is required to use this script,*it is completely open source and can be opened*in notepad."
+echo "**" ANSI_15 "For your own safety, please read the warnings*written at the top of the script before*using it!*"
+
+# get user input
+getinput $sector2 "Enter sector to trade to" 0
+getinput $timesLeft "Enter times to execute script" 0
+getinput $percent "Enter markup/markdown percentage" 5
+
+# get the current sector
+send "d"
+setTextLineTrigger 1 :getSectorNumber "Sector  : "
+pause
+
+:getSectorNumber
+getWord CURRENTLINE $sector1 3
+setVar $thisSector $sector1
+
+:sub_Trade
+  killTrigger 0
+  killTrigger 1
+  killTrigger 2
+  killTrigger 3
+  killTrigger 4
+  send "pt"
+  waitfor "-----"
+  getSector $thisSector $thisSect
+
+  if ($thisSector = $sector1)
+    getSector $sector2 $otherSect
+  else
+    getSector $sector1 $otherSect
+  end
+
+  if ($thisSect.Port.Class = 3) or ($thisSect.Port.Class = 4) or ($thisSect.Port.Class = 5) or ($thisSect.Class = 7)
+    setVar $portStage 0
+  end
+  if ($thisSect.Port.Class = 2) or ($thisSect.Port.Class = 6)
+    setVar $portStage 1
+  else
+    setVar $portStage 2
+  end
+
+  # haggle it!
+  setTextLineTrigger 1 :selectHoldsSell "We are buying up to"
+  setTextLineTrigger 2 :selectHoldsBuy "We are selling up to"
+  setTextTrigger 3 :done "Command [TL="
+  setTextTrigger 4 :sub_Trade "We're not interested."
+  pause
+
+  :selectHoldsSell
+  send "*"
+  setTextLineTrigger 1 :Haggle_Sell "We'll buy them for"
+  pause
+
+  :Haggle_Sell
+  getWord CURRENTLINE $startPrice 5
+  stripText $startPrice ","
+  setVar $sellPerc (100 + $percent)
+
+  :sub_Sell
+    killTrigger 1
+    killTrigger 0
+    setVar $price $startPrice
+    multiply $price $sellPerc
+    divide $price 100
+    send $price "*"
+    subtract $sellPerc 1
+    setTextLineTrigger 1 :sub_Sell "We'll buy them for"
+    setTextLineTrigger 0 :sub_Sell "Our final offer"
+    pause
+
+  :selectHoldsBuy
+  killTrigger 1
+  killTrigger 0
+
+  # see if we should buy this stuff - there might be a more profitable
+  # thing to buy here
+
+  # first see what we're trading
+  setTextTrigger 2 :getTradeType "How many holds of"
+  pause
+  :getTradeType
+  getWord CURRENTLINE $tradeType 5
+
+  if ($tradeType = "Fuel")
+    if (($thisSect.Port.Class = 5) or ($thisSect.Port.Class = 7)) and (($otherSect.Port.Class = 2) or ($otherSect.Port.Class = 3) or ($otherSect.Port.Class = 4) or ($otherSect.Port.Class = 8))
+      # can buy equipment - fuel ore is worthless.
+      send "0*"
+      setTextLineTrigger 2 :selectHoldsBuy "We are selling up to"
+      pause
+    end
+
+    if (($thisSect.Port.Class = 4) or ($thisSect.Port.Class = 7)) and (($otherSect.Port.Class = 1) or ($otherSect.Port.Class = 3) or ($otherSect.Port.Class = 5) or ($otherSect.Port.Class = 8))
+      # can buy organics - fuel ore is worthless.
+      send "0*"
+      setTextLineTrigger 2 :selectHoldsBuy "We are selling up to"
+      pause
+    end
+
+    if (($thisSect.Port.Class = 4) or ($thisSect.Port.Class = 7) or ($thisSect.Port.Class = 3) or ($thisSect.Port.Class = 5)) and (($otherSect.Port.Class = 3) or ($otherSect.Port.Class = 4) or ($otherSect.Port.Class = 5) or ($otherSect.Port.Class = 7))
+      # no point buying fuel if it can't be sold
+      send "0*"
+      setTextLineTrigger 2 :selectHoldsBuy "We are selling up to"
+      pause
+    end
+  end
+
+  if ($tradeType = "Organics")
+    if (($thisSect.Port.Class = 6) or ($thisSect.Port.Class = 7)) and (($otherSect.Port.Class = 2) or ($otherSect.Port.Class = 3) or ($otherSect.Port.Class = 4) or ($otherSect.Port.Class = 8))
+      # can buy equipment - organics is worthless.
+      send "0*"
+      setTextLineTrigger 2 :selectHoldsBuy "We are selling up to"
+      pause
+    end
+
+    if (($thisSect.Port.Class = 2) or ($thisSect.Port.Class = 4) or ($thisSect.Port.Class = 6) or ($thisSect.Port.Class = 7)) and (($otherSect.Port.Class = 2) or ($otherSect.Port.Class = 4) or ($otherSect.Port.Class = 6) or ($otherSect.Port.Class = 7))
+      # no point buying organics if it can't be sold
+      send "0*"
+      setTextLineTrigger 2 :selectHoldsBuy "We are selling up to"
+      pause
+    end
+  end
+
+  if ($tradeType = "Equipment")
+    if (($otherSect.Port.Class = 1) or ($otherSect.Port.Class = 5) or ($otherSect.Port.Class = 6) or ($otherSect.Port.Class = 7))
+      # no point buying equipment if it can't be sold
+      send "0*"
+      setTextLineTrigger 2 :selectHoldsBuy "We are selling up to"
+      pause
+    end
+  end
+
+  send "*"
+  setTextLineTrigger 2 :Haggle_Buy "We'll sell them for"
+  pause
+
+  :Haggle_Buy
+  getWord CURRENTLINE $startPrice 5
+  stripText $startPrice ","
+  setVar $buyPerc (100 - $percent)
+  
+  :sub_Buy
+    killTrigger 1
+    killTrigger 0
+    setVar $price (($startPrice * $buyPerc) / 100)
+    send $price "*"
+    add $buyPerc 1
+    setTextLineTrigger 1 :sub_Buy "We'll sell them for"
+    setTextLineTrigger 0 :sub_Buy "Our final offer"
+    pause
+
+  :done
+
+  if ($thisSector = $sector1)
+    send $sector2 "*"
+    setVar $thisSector $sector2
+  else
+    subtract $timesLeft 1
+
+    if ($timesLeft <= 0)
+      halt
+    end
+
+    send $sector1 "*"
+    setVar $thisSector $sector1
+  end
+
+  waitfor "Sector  : "
+  goto :sub_Trade

+ 1343 - 0
Database.pas

@@ -0,0 +1,1343 @@
+{
+Copyright (C) 2005  Remco Mulder
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+For source notes please refer to Notes.txt
+For license terms please refer to GPL.txt.
+
+These files should be stored in the root of the compression you 
+received this source in.
+}
+// This unit controls all database access.
+
+unit
+  DataBase;
+
+interface
+
+uses
+  Core,
+  Classes,
+  SysUtils;
+
+const
+  DATABASE_VERSION = 7;
+
+  Day : array[1..7] of string = ('Sun', 'Mon', 'Tues', 'Wed', 'Thurs', 'Fri', 'Sat');
+
+type
+  // Enumerated types
+  TFighterType = (ftToll, ftDefensive, ftOffensive);
+  TSectorExploredType = (etNo, etCalc, etDensity, etHolo);
+  TProductType = (ptFuelOre, ptOrganics, ptEquipment);
+
+  // Exceptions
+  EDatabaseError = class(Exception);
+
+  // database records
+  TDataHeader = record
+    ProgramName : string[12];
+    Version     : Byte;
+    Sectors,
+    StarDock,
+    Class0_1,
+    Class0_2    : Word;
+    Address,
+    Description : string[40];
+    Port        : Word;
+    LoginScript : string[255];
+    Password,
+    LoginName   : string[40];
+    Game        : Char;
+    UseLogin    : Boolean;
+    RobFactor,
+    StealFactor : Byte;
+    LastPortCIM : TDateTime;
+  end;
+  PDataHeader = ^TDataHeader;
+
+  TSpaceObject = record
+    Quantity : LongInt;
+    Owner    : string[40];
+    FigType  : TFighterType;
+  end;
+  PTrader = ^TTrader;
+  TTrader = record
+    Name,
+    ShipType,
+    ShipName    : string[40];
+    Figs        : LongInt;
+    NextTrader  : LongInt;
+  end;
+  PShip = ^TShip;
+  TShip = record
+    Name,
+    Owner,
+    ShipType    : string[40];
+    Figs        : LongInt;
+    NextShip    : LongInt;
+  end;
+  TPort = record
+    Name           : string[40];
+    Dead           : Boolean;
+    BuildTime,
+    ClassIndex     : Byte;
+    BuyProduct     : array[TProductType] of Boolean;
+    ProductPercent : array[TProductType] of Byte;
+    ProductAmount  : array[TProductType] of Word;
+    UpDate         : TDateTime;
+  end;
+  PSector = ^TSector;
+  TSector = record
+//    Index         : Word;
+    Warp          : array[1..6] of Word;
+    SPort         : TPort;
+    NavHaz        : Byte;
+    Figs,
+    Mines_Armid,
+    Mines_Limpet  : TSpaceObject;
+    Constellation,
+    Beacon        : string[40];
+    UpDate        : TDateTime;
+    Anomoly       : Boolean;
+    Density       : LongInt;
+    Warps         : Byte;
+    Explored      : TSectorExploredType;
+    Ships,
+    Traders,
+    Planets,
+    Vars          : LongInt;
+  end;
+  PPlanet = ^TPlanet;
+  TPlanet = record
+    Name       : string[40];
+    NextPlanet : LongInt;
+  end;
+  PWarpIn = ^TWarpIn;
+  TWarpIn = record
+    Origin     : Word;
+    NextWarpIn : PWarpIn;
+  end;
+
+  TSectorVar = record
+    VarName: string[10];
+    Value: string[40];
+    NextVar: LongInt;
+  end;
+  PSectorVar = ^TSectorVar;
+
+  TSectorItem = (itPlanet, itTrader, itShip);
+
+  TEmptyRecordGroup = record
+    RecordSize   : Word;
+    EmptyRecords : array of Integer;
+  end;
+
+  TModDatabase = class(TTWXModule, IModDatabase, ITWXGlobals)
+  private
+    CacheAllocated,
+    FRecording,
+    FUseCache,
+    FDataBaseOpen     : Boolean;
+    FDataFilename     : string;
+    DataFile          : File;
+    DataCache,
+    SectorWarpCache   : Pointer;
+    DBSize,
+    CacheSize         : Integer;
+    EmptyRecordGroups : array of TEmptyRecordGroup;
+    FDBHeader         : TDataHeader;
+    FProgramDir       : string;
+
+    procedure AddSectorVar(SectorIndex: Integer; SectorVar: PSectorVar);
+    procedure FindSectorVar(SectorIndex: Integer; const VarName: string; var SectorVar: PSectorVar; var Index: Integer);
+    procedure DeleteSectorVar(SectorIndex: Integer; const VarName: string);
+    procedure AddWarpIn(Sect, Origin : Word);
+    function GetEmptyRecord(Size : Integer) : Integer;
+    procedure CacheEmptyRecords;
+    procedure CacheEmptyRecord(Index : Integer; Size : Word);
+    procedure ReadRecordList(List : TList; FirstPos : Integer);
+    function WriteRecordList(List : TList; RecordSize : Word) : Integer;
+    procedure PurgeRecordList(FirstPos : Integer);
+    procedure WriteRecord(Rec : Pointer; Pos, Next : Integer; Size : Word);
+    procedure ReadData(Data : Pointer; Index, Size : Integer);
+    procedure WriteData(Data : Pointer; Index, Size : Integer);
+    procedure OpenCache;
+    procedure CloseCache;
+    function GetLastPortCIM: TDateTime;
+    procedure SetLastPortCIM(const Value: TDateTime);
+
+  protected
+
+    { ITWXGlobals }
+    function GetProgramDir: string;
+    procedure SetProgramDir(const Value: string);
+
+    { IModDatabase }
+    function GetDatabaseName: string;
+    procedure SetDatabaseName(const Value: string);
+    function GetUseCache: Boolean;
+    procedure SetUseCache(Value: Boolean);
+    function GetRecording: Boolean;
+    procedure SetRecording(Value: Boolean);
+
+  public
+    procedure AfterConstruction; override;
+    procedure BeforeDestruction; override;
+
+    // DB control methods
+    procedure OpenDataBase(Filename : string);
+    procedure CloseDataBase;
+    procedure CreateDatabase(Filename : string; Head : TDataHeader);
+
+    // main storage/retrieval methods
+    procedure SaveSector(S: TSector; Index: Integer; ShipList: TList = nil; TraderList: TList = nil; PlanetList: TList = nil);
+    function LoadSector(I : Integer) : TSector;
+    procedure UpdateWarps(SectIndex : Integer);
+    function GetSectorItems(ItemType : TSectorItem; Sector : TSector) : TList;
+    function GetWarpsIn(Sect : Integer) : TList;
+    function GetBackDoors(S: TSector; SectorIndex: Integer) : TList;
+    function PlotWarpCourse(FromSect, ToSect : Word) : TList;
+    procedure WriteHeader;
+    procedure DumpData;
+    procedure SetSectorVar(SectorIndex: Integer; const VarName, VarValue: string);
+    function GetSectorVar(SectorIndex: Integer; const VarName: string): string;
+
+    // null item retrieval
+    procedure NULLSector(var Sector : TSector);
+    procedure NULLPlanet(var Planet : TPlanet);
+    procedure NULLTrader(var Trader : TTrader);
+    procedure NULLShip(var Ship : TShip);
+
+    property Sectors[Index : Integer] : TSector read LoadSector;
+    property DataBaseOpen : Boolean read FDataBaseOpen;
+    property DBHeader: TDataHeader read FDBHeader;
+    property LastPortCIM: TDateTime read GetLastPortCIM write SetLastPortCIM;
+
+  published
+    property DatabaseName: string read GetDatabaseName write SetDatabaseName;
+    property UseCache: Boolean read GetUseCache write SetUseCache;
+    property Recording: Boolean read GetRecording write SetRecording;
+  end;
+
+function GetBlankHeader : PDataHeader;
+
+implementation
+
+uses
+  Global,
+  Utility,
+  Windows,
+  Forms,
+  Ansi,
+  Dialogs;
+
+type
+  TWarpItem = class(TObject)
+  public
+    Index     : Word;
+    Parent    : TWarpItem;
+  end;
+
+
+function WarpsTo(Source: TSector; DestIndex: Integer) : Boolean;
+begin
+  WarpsTo := (Source.Warp[1] = DestIndex)
+    or (Source.Warp[2] = DestIndex)
+    or (Source.Warp[3] = DestIndex)
+    or (Source.Warp[4] = DestIndex)
+    or (Source.Warp[5] = DestIndex)
+    or (Source.Warp[6] = DestIndex);
+end;
+
+function GetBlankHeader : PDataHeader;
+begin
+  Result := AllocMem(SizeOf(TDataHeader));
+
+  ZeroMemory(Result, SizeOf(TDataHeader));
+
+  Result^.ProgramName := 'TWX DATABASE';
+  Result^.Version := DATABASE_VERSION;
+  Result^.Address := '<Server>';
+  Result^.Port := 23;
+end;
+
+
+
+// ***********************************************************
+// Public Implementation
+
+
+procedure TModDatabase.AfterConstruction;
+begin
+  inherited;
+
+  // initialise variables
+  FDatabaseOpen := FALSE;
+  SectorWarpCache := nil;
+  FUseCache := True;
+  FRecording := True;
+end;
+
+procedure TModDatabase.BeforeDestruction;
+begin
+  // ensure database is closed
+  CloseDataBase;
+
+  inherited;
+end;
+
+function TModDatabase.GetProgramDir: string;
+begin
+  Result := FProgramDir;
+end;
+
+procedure TModDatabase.SetProgramDir(const Value: string);
+begin
+  FProgramDir := Value;
+end;
+
+
+
+// ---------------------------
+// DB control methods
+
+procedure TModDatabase.OpenDataBase(Filename : string);
+var
+  WarpCount,
+  I,
+  X         : Integer;
+  S         : TSector;
+begin
+  if (DataBaseOpen) then
+    Exit;
+
+  TWXServer.Broadcast(endl + ANSI_15 + 'Loading database: ' + ANSI_7 + Filename + endl);
+  FDataFilename := Filename;
+  SetCurrentDir(FProgramDir);
+
+  // Open database
+  AssignFile(DataFile, Filename);
+
+{$I-}
+  Reset(DataFile, 1);
+
+  if (IOResult <> 0) then
+  begin
+    TWXServer.Broadcast(endl + ANSI_12 + 'Warning: This database does not exist.  No data will be saved/retrieved' + ANSI_7 + endl);
+    CloseDatabase;
+    Exit;
+  end;
+{$I+}
+
+  // Check database validity and version number
+  Seek(DataFile, 0);
+  BlockRead(DataFile, FDBHeader, SizeOf(TDataHeader));
+
+  if (DBHeader.ProgramName <> 'TWX DATABASE') then
+  begin
+    TWXServer.Broadcast(endl + ANSI_12 + 'Warning: This database has been corrupted, no data will be saved/retrieved' + ANSI_7 + endl);
+    CloseDatabase;
+    Exit;
+  end;
+
+  if (DBHeader.Version <> DATABASE_VERSION) then
+  begin
+    TWXServer.Broadcast(endl + ANSI_12 + 'Warning: Database version ' + IntToStr(DBHeader.Version) + ', expected version ' + IntToStr(DATABASE_VERSION) + ', no data will be saved/retrieved' + ANSI_7 + endl);
+    CloseDatabase;
+    Exit;
+  end;
+
+  if (UseCache) then
+    OpenCache
+  else
+    CloseCache;
+
+  FDatabaseOpen := TRUE;
+  DBSize := FileSize(DataFile);
+
+  // cache empty record indexes
+  CacheEmptyRecords;
+
+  // construct sector warp cache
+  SectorWarpCache := AllocMem(DBHeader.Sectors * 4);
+  WarpCount := 0;
+
+  for I := 1 to DBHeader.Sectors do
+  begin
+    S := LoadSector(I);
+
+    for X := 1 to 6 do
+      if (S.Warp[X] > 0) then
+      begin
+        Inc(WarpCount);
+        AddWarpIn(S.Warp[X], I);
+      end
+      else
+        Break;
+  end;
+
+  TWXLog.DatabaseChanged;
+
+  TWXServer.Broadcast(endl + ANSI_15 + 'Database successfully loaded - ' + IntToStr(DBHeader.Sectors) + ' sectors, ' + IntToStr(WarpCount) + ' warps' + endl);
+
+  TWXGUI.DatabaseName := StripFileExtension(ShortFilename(Filename));
+end;
+
+procedure TModDatabase.CloseDataBase;
+var
+  W,
+  Last     : PWarpIn;
+  P        : Pointer;
+  I,
+  CacheEnd : Integer;
+begin
+  if not (FDatabaseOpen) then
+    Exit;
+
+{$I-}
+  CloseFile(DataFile);
+{$I+}
+  FDatabaseOpen := FALSE;
+
+  // deconstruct sector warp cache
+  P := SectorWarpCache;
+  CacheEnd := Integer(P) + DBHeader.Sectors * 4;
+
+  while (Integer(P) < CacheEnd) do
+  begin
+    W := PWarpIn(P^);
+
+    while (W <> nil) do
+    begin
+      Last := W;
+      W := W^.NextWarpIn;
+      FreeMem(Last);
+    end;
+
+    P := Pointer(Integer(P) + SizeOf(Pointer));
+  end;
+
+  // purge old empty record caches
+  if (Length(EmptyRecordGroups) > 0) then
+    for I := 0 to Length(EmptyRecordGroups) - 1 do
+      SetLength(EmptyRecordGroups[I].EmptyRecords, 0);
+
+  SetLength(EmptyRecordGroups, 0);
+
+  FreeMem(SectorWarpCache);
+  CloseCache;
+  FDataFilename := '';
+end;
+
+procedure TModDatabase.CreateDatabase(Filename : string; Head : TDataHeader);
+var
+  I        : Integer;
+  Sect     : TSector;
+  F        : File;
+  FileOpen : Boolean;
+begin
+  // Make a database - it doesn't exist
+  TWXServer.Broadcast(endl + ANSI_15 + 'Creating database: ' + ANSI_7 + Filename + ANSI_15 + ' (' + IntToStr(Head.Sectors) + ')' + ANSI_7 + endl);
+  SetCurrentDir(FProgramDir);
+
+  FileOpen := FALSE;
+  
+  try
+    AssignFile(F, Filename);
+    ReWrite(F, 1);
+    FileOpen := TRUE;
+    BlockWrite(F, Head, SizeOf(TDataHeader));
+    NULLSector(Sect);
+
+    for I := 0 to Head.Sectors do
+      BlockWrite(F, Sect, SizeOf(Sect));
+  finally
+    if (FileOpen) then
+      CloseFile(F);
+  end;
+end;
+
+// ---------------------------
+// main storage/retrieval methods
+
+procedure TModDatabase.SaveSector(S: TSector; Index: Integer; ShipList: TList = nil; TraderList: TList = nil; PlanetList: TList = nil);
+var
+  Sect    : TSector;
+  I,
+  X       : Integer;
+  Bad,
+  Found   : Boolean;
+  WarpsIn : TList;
+  Product : TProductType;
+begin
+  // Save this sector to file if set to record data
+
+  if (Recording) and (DatabaseOpen) then
+  begin
+    Bad := (Index < 1) or (Index > DBHeader.Sectors);
+    I := 1;
+
+    while not Bad and (I <= 6) do
+    begin
+      if (S.Warp[I] > DBHeader.Sectors) then
+        Bad := True;
+        
+      Inc(I);
+    end;
+
+    if Bad then
+    begin
+      SetForegroundWindow(Application.Handle);
+      TWXServer.ClientMessage('Unable to store sector ''' + IntToStr(Index) + ''', closing database.');
+      CloseDatabase;
+      Exit;
+    end;
+
+    ReadData(@Sect, Index * SizeOf(TSector) + SizeOf(TDataHeader), SizeOf(Sect));
+
+    // If this sector has been probed, recall warps if seen before
+    if (S.Warp[1] = 0) and (Sect.Warp[1] <> 0) then
+      S.Warp := Sect.Warp;
+
+    // Don't go over density or anomoly readings unless this is a density scan
+    if (S.Density = -1) then
+    begin
+      S.Density := Sect.Density;
+      S.Anomoly := Sect.Anomoly;
+    end;
+
+    // Don't go over port details unless they are specified
+    if (S.SPort.UpDate = 0) then
+    begin
+      S.SPort.Update := Sect.SPort.UpDate;
+
+      for Product := Low(TProductType) to High(TProductType) do
+      begin
+        S.SPort.ProductAmount[Product] := Sect.SPort.ProductAmount[Product];
+        S.SPort.ProductPercent[Product] := Sect.SPort.ProductPercent[Product];
+      end;
+    end;
+
+    // save stardock details if this sector has it
+    if (S.SPort.ClassIndex = 9) and (Sect.SPort.ClassIndex <> 9) then
+    begin
+      FDBHeader.StarDock := Index;
+      WriteHeader;
+    end;
+
+    // update sector warp count
+    S.Warps := 6;
+
+    for I := 1 to 6 do
+      if (S.Warp[I] = 0) then
+      begin
+        S.Warps := I - 1;
+        Break;
+      end;
+
+    // Purge old ship, trader and planet data
+    PurgeRecordList(Sect.Ships);
+    PurgeRecordList(Sect.Traders);
+    PurgeRecordList(Sect.Planets);
+
+    // Write the ships to file
+    S.Ships := WriteRecordList(ShipList, SizeOf(TShip));
+
+    // Write the traders to file
+    S.Traders := WriteRecordList(TraderList, SizeOf(TTrader));
+
+    // Write the planets to file
+    S.Planets := WriteRecordList(PlanetList, SizeOf(TPlanet));
+
+    // write sector to database
+    WriteData(@S, Index * SizeOf(TSector) + SizeOf(TDataHeader), SizeOf(TSector));
+
+    // Update sector warp cache with new specs (if need be)
+    for I := 1 to 6 do
+      if (S.Warp[I] > 0) then
+      begin
+        WarpsIn := GetWarpsIn(S.Warp[I]);
+
+        // see if its in there already
+        X := 0;
+        Found := FALSE;
+
+        while (X < WarpsIn.Count) do
+        begin
+          if (TWarpIn(WarpsIn.Items[X]^).Origin = Index) then
+          begin
+            Found := TRUE;
+            Break;
+          end;
+
+          Inc(X);
+        end;
+
+        WarpsIn.Free;
+
+        if not (Found) then
+          AddWarpIn(S.Warp[I], Index);
+      end
+      else
+        Break;
+  end;
+end;
+
+function TModDatabase.LoadSector(I : Integer) : TSector;
+begin
+  if (I <= 0) or (I > DBHeader.Sectors) then
+    raise EDatabaseError.Create('Unable to load sector: ' + IntToStr(I));
+
+  if not (DatabaseOpen) then
+    // no database or database is corrupt - load a blank sector
+    NULLSector(Result)
+  else
+    ReadData(@Result, I * SizeOf(TSector) + SizeOf(TDataHeader), SizeOf(TSector));
+end;
+
+procedure TModDatabase.UpdateWarps(SectIndex : Integer);
+var
+  I : Integer;
+  S : TSector;
+begin
+  // find out how many warps there are going out of this sector
+  S := LoadSector(SectIndex);
+
+  I := 1;
+
+  while (I <= 6) do
+  begin
+    if (S.Warp[I] = 0) then
+      Break;
+
+    Inc(I);
+  end;
+
+  S.Warps := I;
+  SaveSector(S, SectIndex, nil, nil, nil);
+end;
+
+function TModDatabase.GetSectorItems(ItemType : TSectorItem; Sector : TSector) : TList;
+begin
+  Result := TList.Create;
+
+  if not (DatabaseOpen) then
+    // no database or database is corrupt
+    Exit;
+
+  if (ItemType = itPlanet) then
+    ReadRecordList(Result, Sector.Planets)
+  else if (ItemType = itTrader) then
+    ReadRecordList(Result, Sector.Traders)
+  else if (ItemType = itShip) then
+    ReadRecordList(Result, Sector.Ships);
+end;
+
+function TModDatabase.GetWarpsIn(Sect : Integer) : TList;
+var
+  W : PWarpIn;
+begin
+  Result := TList.Create;
+
+  if not (DatabaseOpen) then
+    Exit;
+
+  W := PWarpIn(Pointer(Integer(SectorWarpCache) + (Sect - 1) * 4)^);
+
+  while (W <> nil) do
+  begin
+    Result.Add(W);
+    W := W^.NextWarpIn;
+  end;
+end;
+
+function TModDatabase.GetBackDoors(S: TSector; SectorIndex: Integer) : TList;
+var
+  I       : Integer;
+  W       : PWarpIn;
+  Sect    : ^Word;
+  WarpsIn : TList;
+begin
+  WarpsIn := GetWarpsIn(SectorIndex);
+  Result := TList.Create;
+
+  if not (DatabaseOpen) then
+    // no database or database is corrupt
+    Exit;
+    
+  I := 0;
+
+  while (I < WarpsIn.Count) do
+  begin
+    W := PWarpIn(WarpsIn.Items[I]);
+
+    if not (WarpsTo(S, W^.Origin)) then
+    begin
+      Sect := AllocMem(SizeOf(Word));
+      Sect^ := W^.Origin;
+      Result.Add(Sect);
+    end;
+
+    Inc(I);
+  end;
+
+  WarpsIn.Free;
+end;
+
+function TModDatabase.PlotWarpCourse(FromSect, ToSect : Word) : TList;
+var
+  S        : TSector;
+  Warp     : TWarpItem;
+  Map,
+  ItemDone : Pointer;
+  I,
+  X,
+  ListSize,
+  Avoid    : Integer;
+  CurWarp  : TWarpItem;
+  W        : ^Word;
+
+  procedure AddItem(Index : Word; Parent : TWarpItem);
+  var
+    NewWarp : TWarpItem;
+  begin
+    NewWarp := TWarpItem.Create;
+    NewWarp.Parent := Parent;
+    NewWarp.Index := Index;
+    TWarpItem(Pointer(Integer(Map) + ListSize * SizeOf(Pointer))^) := NewWarp;
+
+    // record this sector as added
+    Byte(Pointer(Integer(ItemDone) + Index - 1)^) := 1;
+
+    Inc(ListSize);
+  end;
+
+begin
+  Result := TList.Create;
+
+  if not (DatabaseOpen) then
+    // no database or database is corrupt
+    Exit;
+
+  Map := AllocMem((DBHeader.Sectors + 1) * SizeOf(Pointer));
+  ItemDone := AllocMem(DBHeader.Sectors + 1);
+  ListSize := 1;
+  I := 0;
+  Warp := TWarpItem.Create;
+  Warp.Parent := nil;
+  Warp.Index := FromSect;
+  TWarpItem(Map^) := Warp;
+
+  repeat
+    if (I >= ListSize) then
+      Break;
+
+    CurWarp := TWarpItem(Pointer(Integer(Map) + I * SizeOf(Pointer))^);
+
+    if (CurWarp.Index = ToSect) then
+    begin
+      // get the path
+      Warp := CurWarp;
+
+      while (Warp <> nil) do
+      begin
+        W := AllocMem(SizeOf(Word));
+        W^ := Warp.Index;
+        Result.Add(W);
+        Warp := Warp.Parent;
+      end;
+
+      Break;
+    end;
+
+    // get the warps out and add them to the map
+    S := LoadSector(CurWarp.Index);
+
+    if (CurWarp.Parent = nil) then
+      Avoid := 0
+    else
+      Avoid := CurWarp.Parent.Index;
+
+    X := 1;
+    while (X <= 6) and (S.Warp[X] <> 0) do
+    begin
+      // Add warp to the list
+      if (S.Warp[X] <> Avoid) and (Byte(Pointer(Integer(ItemDone) + S.Warp[X] - 1)^) = 0) then
+        AddItem(S.Warp[X], CurWarp);
+
+      Inc(X);
+    end;
+
+    Inc(I);
+
+  until (I >= DBHeader.Sectors);
+
+  for I := ListSize - 1 downto 0 do
+    TWarpItem(Pointer(Integer(Map) + I * SizeOf(Pointer))^).Free;
+
+  FreeMem(Map);
+  FreeMem(ItemDone);
+end;
+
+procedure TModDatabase.WriteHeader;
+begin
+  if not (DatabaseOpen) then
+    // no database or database is corrupt
+    Exit;
+
+  // update the DB header in file and cache
+  WriteData(@DBHeader, 0, SizeOf(TDataHeader));
+end;
+
+procedure TModDatabase.DumpData;
+var
+  Next,
+  Pos   : Integer;
+  Size  : Word;
+  InUse : Byte;
+  InUseStr : string;
+begin
+  // dump stored records
+
+  Pos := SizeOf(TSector) * (DBHeader.Sectors + 1) + SizeOf(TDataHeader);
+
+  while (Pos < DBSize) do
+  begin
+    ReadData(@Size, Pos, 2);
+    ReadData(@InUse, Pos + 2, 1);
+    ReadData(@Next, Pos + 3, 4);
+
+    if (InUse <> 0) then
+      InUseStr := 'YES'
+    else
+      InUseStr := 'NO';
+
+    TWXServer.Broadcast(endl + ANSI_15 + 'In use: ' + ANSI_14 + InUseStr);
+    TWXServer.Broadcast(endl + ANSI_15 + 'Size: ' + ANSI_14 + IntToStr(Size));
+    TWXServer.Broadcast(endl + ANSI_15 + 'Next: ' + ANSI_14 + IntToStr(Next) + endl);
+
+    Inc(Pos, Size + 7);
+  end;
+end;
+
+procedure TModDatabase.SetSectorVar(SectorIndex: Integer; const VarName, VarValue: string);
+var
+  SectorVar: PSectorVar;
+  VarOffset: Integer;
+  P: Pointer;
+begin
+  if (VarValue = '') then
+    DeleteSectorVar(SectorIndex, VarName)
+  else
+  begin
+    FindSectorVar(SectorIndex, VarName, SectorVar, VarOffset);
+
+    if Assigned(SectorVar) then
+    begin
+      // Record already exists - write over the Value part of it
+      SectorVar.Value := VarValue;
+
+      // 7 Bytes record overhead + 10 bytes var name in record
+      P := Pointer(Integer(SectorVar) + 10);
+      WriteData(P, VarOffset + 17, 40);
+    end
+    else
+    begin
+      // Record doesn't exist - create a new one
+      SectorVar := AllocMem(SizeOf(TSectorVar));
+      SectorVar.VarName := VarName;
+      SectorVar.Value := VarValue;
+      AddSectorVar(SectorIndex, SectorVar);
+      Dispose(SectorVar);
+    end;
+  end;
+end;
+
+function TModDatabase.GetSectorVar(SectorIndex: Integer; const VarName: string): string;
+var
+  SectorVar: PSectorVar;
+  VarOffset: Integer;
+begin
+  // return value of this sector variable
+  FindSectorVar(SectorIndex, VarName, SectorVar, VarOffset);
+
+  if Assigned(SectorVar) then
+    Result := SectorVar.Value
+  else
+    Result := '';
+end;
+
+
+// ---------------------------
+// null item retrieval
+
+
+procedure TModDatabase.NULLSector(var Sector : TSector);
+begin
+  ZeroMemory(@Sector, SizeOf(Sector));
+
+  Sector.Density := -1;
+end;
+
+procedure TModDatabase.NULLPlanet(var Planet : TPlanet);
+begin
+  ZeroMemory(@Planet, SizeOf(Planet));
+end;
+
+procedure TModDatabase.NULLTrader(var Trader : TTrader);
+begin
+  ZeroMemory(@Trader, SizeOf(Trader));
+end;
+
+procedure TModDatabase.NULLShip(var Ship : TShip);
+begin
+  ZeroMemory(@Ship, SizeOf(Ship));
+end;
+
+
+// ***********************************************************
+// Protected Implementation
+
+
+procedure TModDatabase.AddSectorVar(SectorIndex: Integer; SectorVar: PSectorVar);
+const
+  RecordSize = SizeOf(TSectorVar);
+var
+  RecPtr,
+  RecPos,
+  NextRecord: Integer;
+  S: TSector;
+begin
+  // seek the end of the sector variable list for this sector and add the variable
+
+  NextRecord := Sectors[SectorIndex].Vars;
+  RecPtr := NextRecord;
+
+  while (NextRecord <> 0) do
+  begin
+    RecPtr := NextRecord + 3;
+    ReadData(@NextRecord, RecPtr, 4);
+  end;
+
+  RecPos := GetEmptyRecord(RecordSize);
+
+  if (RecPtr = 0) then
+  begin
+    // update sector directly (no variables yet)
+    S := LoadSector(SectorIndex);
+    S.Vars := RecPos;
+    SaveSector(S, SectorIndex);
+  end
+  else
+    WriteData(@RecPos, RecPtr, 4);
+
+  WriteRecord(SectorVar, RecPos, 0, RecordSize);
+end;
+
+procedure TModDatabase.FindSectorVar(SectorIndex: Integer; const VarName: string; var SectorVar: PSectorVar; var Index: Integer);
+const
+  RecordSize = SizeOf(TSectorVar);
+var
+  NextRecord : Integer;
+begin
+  // Locate a sector variable of the specific name within the database, returning
+  // a pointer to a record representing it in memory, and the index of its position
+  // within the database.
+
+  NextRecord := Sectors[SectorIndex].Vars;
+  Index := 0;
+
+  while (NextRecord <> 0) do
+  begin
+    SectorVar := AllocMem(RecordSize);
+    ReadData(SectorVar, NextRecord + 7, RecordSize);
+
+    if (SectorVar.VarName = VarName) then
+    begin
+      Index := NextRecord;
+      Dispose(SectorVar);
+      Break;
+    end;
+
+    Dispose(SectorVar);
+    ReadData(@NextRecord, NextRecord + 3, 4);
+  end;
+
+  if (Index = 0) then
+    SectorVar := nil;
+end;
+
+procedure TModDatabase.DeleteSectorVar(SectorIndex: Integer; const VarName: string);
+const
+  RecordSize = SizeOf(TSectorVar);
+var
+  LastRecord,
+  ThisRecord,
+  NextRecord: Integer;
+  S: TSector;
+  SectorVar: PSectorVar;
+begin
+  // Find the sector var with a matching name and unlink it from the list,
+  // flagging it as inactive.
+
+  ThisRecord := Sectors[SectorIndex].Vars;
+  LastRecord := 0;
+  NextRecord := 0;
+
+  while (ThisRecord <> 0) do
+  begin
+    SectorVar := AllocMem(RecordSize);
+    ReadData(SectorVar, ThisRecord + 7, RecordSize);
+    ReadData(@NextRecord, ThisRecord + 3, 4);
+
+    if (SectorVar.VarName = VarName) then
+    begin
+      // update previous record
+
+      if (LastRecord = 0) then
+      begin
+        // previous record is root (sector), update it
+        S := LoadSector(SectorIndex);
+        S.Vars := NextRecord;
+        SaveSector(S, SectorIndex);
+      end
+      else
+      begin
+        // previous record is another record
+        WriteData(@NextRecord, LastRecord + 3, 4);
+      end;
+
+      NextRecord := 0; // exit loop
+    end;
+
+    Dispose(SectorVar);
+
+    LastRecord := ThisRecord;
+    ThisRecord := NextRecord;
+  end;
+end;
+
+procedure TModDatabase.AddWarpIn(Sect, Origin : Word);
+var
+  P : Pointer;
+  W : PWarpIn;
+begin
+  W := AllocMem(SizeOf(TWarpIn));
+  W^.Origin := Origin;
+
+  // hook the new warp into this sector's warpin list
+  P := Pointer(Integer(SectorWarpCache) + (Sect - 1) * SizeOf(Pointer));
+  W^.NextWarpIn := PWarpIn(P^);
+  Pointer(P^) := W;
+end;
+
+function TModDatabase.GetEmptyRecord(Size : Integer) : Integer;
+var
+  I : Integer;
+begin
+  Result := DBSize;
+  I := 0;
+
+  while (I < Length(EmptyRecordGroups)) do
+  begin
+    if (EmptyRecordGroups[I].RecordSize = Size) then
+    begin
+      if (Length(EmptyRecordGroups[I].EmptyRecords) > 0) then
+      begin
+        Result := EmptyRecordGroups[I].EmptyRecords[Length(EmptyRecordGroups[I].EmptyRecords) - 1];
+        SetLength(EmptyRecordGroups[I].EmptyRecords, Length(EmptyRecordGroups[I].EmptyRecords) - 1);
+      end;
+
+      Break;
+    end;
+
+    Inc(I);
+  end;
+end;
+
+procedure TModDatabase.CacheEmptyRecords;
+var
+  Pos   : Integer;
+  Size  : Word;
+  InUse : Byte;
+begin
+  // go through and find all empty records, storing them.
+
+  Pos := SizeOf(TSector) * (DBHeader.Sectors + 1) + SizeOf(TDataHeader);
+
+  while (Pos < DBSize) do
+  begin
+    ReadData(@Size, Pos, 2);
+    ReadData(@InUse, Pos + 2, 1);
+
+    if (InUse = 0) then
+      CacheEmptyRecord(Pos, Size);
+
+    Inc(Pos, Size + 7);
+  end;
+end;
+
+procedure TModDatabase.CacheEmptyRecord(Index : Integer; Size : Word);
+var
+  I     : Integer;
+  Found : Boolean;
+begin
+  // loop through record cache lists, add record to a list matching its size
+
+  Found := FALSE;
+  I := 0;
+
+  while (I < Length(EmptyRecordGroups)) do
+  begin
+    if (EmptyRecordGroups[I].RecordSize = Size) then
+    begin
+      Found := TRUE;
+      Break;
+    end;
+
+    Inc(I);
+  end;
+
+  if not (Found) then
+  begin
+    I := Length(EmptyRecordGroups);
+    SetLength(EmptyRecordGroups, I + 1);
+    EmptyRecordGroups[I].RecordSize := Size;
+  end;
+
+  SetLength(EmptyRecordGroups[I].EmptyRecords, Length(EmptyRecordGroups[I].EmptyRecords) + 1);
+  EmptyRecordGroups[I].EmptyRecords[Length(EmptyRecordGroups[I].EmptyRecords) - 1] := Index;
+end;
+
+procedure TModDatabase.ReadRecordList(List : TList; FirstPos : Integer);
+var
+  NextRecord : Integer;
+  RecordSize : Word;
+  Rec        : Pointer;
+begin
+  NextRecord := FirstPos;
+
+  while (NextRecord <> 0) do
+  begin
+    ReadData(@RecordSize, NextRecord, 2);
+    Rec := AllocMem(RecordSize);
+    ReadData(Rec, NextRecord + 7, RecordSize);
+    List.Add(Rec);
+    ReadData(@NextRecord, NextRecord + 3, 4);
+  end;
+end;
+
+function TModDatabase.WriteRecordList(List : TList; RecordSize : Word) : Integer;
+var
+  I,
+  Pos,
+  LastPos : Integer;
+begin
+  Result := 0;
+
+  if (List <> nil) then
+    if (List.Count > 0) then
+    begin
+      LastPos := 0;
+
+      for I := List.Count - 1 downto 0 do
+      begin
+        // Find the nearest zeroed record (or EOF)
+        Pos := GetEmptyRecord(RecordSize);
+
+        // Write it in
+        WriteRecord(List[I], Pos, LastPos, RecordSize);
+        LastPos := Pos;
+      end;
+
+      Result := LastPos;
+    end;
+end;
+
+procedure TModDatabase.PurgeRecordList(FirstPos : Integer);
+var
+  NextRecord : Integer;
+  InUse      : Byte;
+  Size       : Word;
+begin
+  NextRecord := FirstPos;
+  InUse := 0;
+
+  while (NextRecord <> 0) do
+  begin
+    ReadData(@Size, NextRecord, 2);
+    CacheEmptyRecord(NextRecord, Size);
+    WriteData(@InUse, NextRecord + 2, 1);
+    ReadData(@NextRecord, NextRecord + 3, 4);
+  end;
+end;
+
+procedure TModDatabase.WriteRecord(Rec : Pointer; Pos, Next : Integer; Size : Word);
+var
+  InUse : Byte;
+begin
+  WriteData(@Size, Pos, 2);
+
+  InUse := 1;
+  WriteData(@InUse, Pos + 2, 1);
+  WriteData(@Next, Pos + 3, 4);
+  WriteData(Rec, Pos + 7, Size);
+end;
+
+procedure TModDatabase.ReadData(Data : Pointer; Index, Size : Integer);
+begin
+  if (UseCache) then
+    // cache enabled - read data directly from data cache
+    CopyMemory(Data, Pointer(Integer(DataCache) + Index), Size)
+  else
+  begin
+    // cache disabled - read data from file
+    Seek(DataFile, Index);
+    BlockRead(DataFile, Data^, Size);
+  end;
+end;
+
+procedure TModDatabase.WriteData(Data : Pointer; Index, Size : Integer);
+var
+  DataIndex   : Pointer;
+  CurDatabase : string;
+begin
+  if (UseCache) then
+  begin
+    if (Index + Size > CacheSize) then
+    begin
+      // increase cache size
+      try
+        Inc(CacheSize, 50000);
+        ReallocMem(DataCache, CacheSize);
+      except
+        UseCache := FALSE;
+        CurDatabase := FDataFilename;
+        TWXServer.ClientMessage('Not enough free memory available for cache extensions - database cache disabled');
+        CloseDataBase;
+        OpenDatabase(CurDatabase);
+        WriteData(Data, Index, Size);
+        Exit;
+      end;
+    end;
+
+    DataIndex := Pointer(Integer(DataCache) + Index);
+
+    // compare memory with cached data
+    if not (CompareMem(DataIndex, Data, Size)) then
+    begin
+      // data is different - update data cache and file
+      CopyMemory(DataIndex, Data, Size);
+      Seek(DataFile, Index);
+      BlockWrite(DataFile, Data^, Size);
+      DBSize := FileSize(DataFile);
+    end;
+  end
+  else
+  begin
+    // write data directly to file
+    Seek(DataFile, Index);
+    BlockWrite(DataFile, Data^, Size);
+    DBSize := FileSize(DataFile);
+  end;
+end;
+
+procedure TModDatabase.OpenCache;
+begin
+  // load the database into cache
+
+  if (CacheAllocated) then
+    CloseCache;
+
+  try
+    CacheSize := FileSize(DataFile) + 50000;
+    DataCache := AllocMem(CacheSize);
+    CacheAllocated := TRUE;
+    Seek(DataFile, 0);
+    BlockRead(DataFile, DataCache^, FileSize(DataFile));
+  except
+    TWXServer.Broadcast(endl + ANSI_12 + 'Error while caching database, database cache has been disabled' + ANSI_7 + endl);
+    UseCache := False;
+  end;
+end;
+
+procedure TModDatabase.CloseCache;
+begin
+  // release data cache
+
+  if not (CacheAllocated) then
+    Exit;
+
+  FreeMem(DataCache, CacheSize);
+  CacheSize := 0;
+  CacheAllocated := FALSE;
+end;
+
+function TModDatabase.GetDatabaseName: string;
+begin
+  Result := FDataFilename; 
+end;
+
+procedure TModDatabase.SetDatabaseName(const Value: string);
+begin
+  if (Value <> FDataFilename) then
+  begin
+    CloseDatabase;
+    OpenDatabase(Value);
+  end;
+end;
+
+function TModDatabase.GetUseCache: Boolean;
+begin
+  Result := FUseCache;
+end;
+
+procedure TModDatabase.SetUseCache(Value: Boolean);
+begin
+  if (FUseCache <> Value) then
+  begin
+    FUseCache := Value;
+
+    if (FUseCache) then
+      OpenCache
+    else
+      CloseCache;
+  end;
+end;
+
+function TModDatabase.GetRecording: Boolean;
+begin
+  Result := FRecording; 
+end;
+
+procedure TModDatabase.SetRecording(Value: Boolean);
+begin
+  FRecording := Value;
+  TWXGUI.Recording := Value;
+end;
+
+function TModDatabase.GetLastPortCIM: TDateTime;
+begin
+  Result := DBHeader.LastPortCIM;
+end;
+
+procedure TModDatabase.SetLastPortCIM(const Value: TDateTime);
+begin
+  FDBHeader.LastPortCIM := Value;
+end;
+
+end.

+ 1037 - 0
Process.pas

@@ -0,0 +1,1037 @@
+{
+Copyright (C) 2005  Remco Mulder
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+For source notes please refer to Notes.txt
+For license terms please refer to GPL.txt.
+
+These files should be stored in the root of the compression you 
+received this source in.
+}
+// This unit controls all processing and recording of data
+
+unit
+  Process;
+
+interface
+
+uses
+  Core,
+  Observer,
+  SysUtils,
+  DataBase,
+  Classes;
+
+type
+  TSectorPosition = (spNormal, spPorts, spPlanets, spShips, spMines, spTraders);
+  TDisplay = (dNone, dSector, dDensity, dWarpLane, dCIM, dPortCIM, dPort, dWarpCIM);
+
+  TModExtractor = class(TTWXModule, IModExtractor)
+  private
+    FCurrentSectorIndex : Integer;
+    FSectorPosition     : TSectorPosition;
+    FCurrentDisplay     : TDisplay;
+    FLastWarp           : Integer;
+    FSectorSaved        : Boolean;
+    FCurrentTrader      : TTrader;
+    FCurrentShip        : TShip;
+    FCurrentMessage     : string;
+    FTraderList,
+    FShipList,
+    FPlanetList         : TList;
+
+    FCurrentLine,
+    FCurrentANSILine    : string;
+    FCurrentSector      : TSector;
+    FInAnsi             : Boolean;
+    FMenuKey            : Char;
+
+    procedure SectorCompleted;
+    procedure ResetSectorLists;
+    procedure ProcessPrompt(Line : string);
+    procedure AddWarp(SectNum, Warp : Integer);
+    procedure ProcessWarpLine(Line : String);
+    procedure ProcessCIMLine(Line : String);
+    procedure ProcessSectorLine(Line : String);
+    procedure ProcessLine(Line : String);
+    procedure ProcessPortLine(Line : String);
+    procedure StripANSI(var S : string);
+
+  protected
+    function GetMenuKey: Char;
+    procedure SetMenuKey(Value: Char);
+
+  public
+    procedure AfterConstruction; override;
+    procedure BeforeDestruction; override;
+
+    procedure Reset;
+    procedure ProcessInBound(var InData : string);
+    function ProcessOutBound(OutData : string; ClientIndex : Byte) : Boolean;
+
+    property CurrentLine: string read FCurrentLine write FCurrentLine;
+    property CurrentANSILine: string read FCurrentANSILine write FCurrentANSILine;
+
+  published
+    property MenuKey: Char read GetMenuKey write SetMenuKey;
+  end;
+
+implementation
+
+uses
+  Global,
+  Utility,
+  Ansi;
+
+
+procedure TModExtractor.AfterConstruction;
+begin
+  inherited;
+
+  // Create lists to store ships, traders and planets
+  FShipList := TList.Create;
+  FTraderList := TList.Create;
+  FPlanetList := TList.Create;
+
+  MenuKey := '$';
+end;
+
+procedure TModExtractor.BeforeDestruction;
+begin
+  ResetSectorLists;
+
+  FShipList.Free;
+  FTraderList.Free;
+  FPlanetList.Free;
+
+  inherited;
+end;
+
+procedure TModExtractor.Reset;
+begin
+  // Reset state values
+
+  CurrentLine := '';
+  CurrentANSILine := '';
+  FInAnsi := FALSE;
+  ResetSectorLists;
+end;
+
+function TModExtractor.GetMenuKey: Char;
+begin
+  Result := FMenuKey;
+end;
+
+procedure TModExtractor.SetMenuKey(Value: Char);
+begin
+  FMenuKey := Value;
+end;
+
+
+// ********************************************************************
+// Process inbound data
+
+
+
+procedure TModExtractor.ResetSectorLists;
+begin
+  // Reset all ship, planet and trader lists
+
+  while (FShipList.Count > 0) do
+  begin
+    FreeMem(FShipList[0], SizeOf(TShip));
+    FShipList.Delete(0);
+  end;
+
+  while (FPlanetList.Count > 0) do
+  begin
+    FreeMem(FPlanetList[0], SizeOf(TPlanet));
+    FPlanetList.Delete(0);
+  end;
+
+  while (FTraderList.Count > 0) do
+  begin
+    FreeMem(FTraderList[0], SizeOf(TTrader));
+    FTraderList.Delete(0);
+  end;
+end;
+
+procedure TModExtractor.SectorCompleted;
+var
+  I,
+  WarpIndex : Integer;
+begin
+  if (FCurrentSectorIndex = 0) then
+    Exit;
+
+  FCurrentSector.UpDate := Now;
+  FCurrentSector.Explored := etHolo;
+  FSectorSaved := TRUE;
+  WarpIndex := 0;
+
+  for I := 1 to 6 do
+    if (FCurrentSector.Warp[I] = 0) then
+    begin
+      WarpIndex := I;
+      Break;
+    end;
+
+  if (WarpIndex = 0) then
+    FCurrentSector.Warps := 0
+  else if (FCurrentSector.Warp[WarpIndex] = 0) then
+    FCurrentSector.Warps := WarpIndex - 1
+  else
+    FCurrentSector.Warps := 6;
+
+  TWXDatabase.SaveSector(FCurrentSector, FCurrentSectorIndex, FShipList, FTraderList, FPlanetList);
+  FCurrentSectorIndex := 0;
+  ResetSectorLists;
+end;
+
+procedure TModExtractor.ProcessPrompt(Line : string);
+begin
+  // This procedure checks command prompts.  It is called from both
+  // processline and processinbound, as it can come in as part of
+  // a large packet or still be waiting for the user.
+
+  if (Copy(Line, 1, 12) = 'Command [TL=') then
+  begin
+    // Save current sector if not done already
+    if not (FSectorSaved) then
+      SectorCompleted;
+
+    // No displays anymore, all done
+    FCurrentDisplay := dNone;
+    FLastWarp := 0;
+  end
+  else if (Copy(Line, 1, 23) = 'Probe entering sector :') or (Copy(Line, 1, 20) = 'Probe Self Destructs') then
+  begin
+    // mid probe - save the sector
+    if not (FSectorSaved) then
+      SectorCompleted;
+
+    // No displays anymore, all done
+    FCurrentDisplay := dNone;
+  end
+  else if (Copy(Line, 1, 21) = 'Computer command [TL=') then
+  begin
+    // in computer prompt, kill all displays and clear warp data
+    FCurrentDisplay := dNone;
+    FLastWarp := 0;
+  end
+  else if (Copy(Line, 1, 25) = 'Citadel treasury contains') then
+  begin
+    // In Citadel - Save current sector if not done already
+    if not (FSectorSaved) then
+      SectorCompleted;
+
+    // No displays anymore, all done
+    FCurrentDisplay := dNone;
+  end
+  else if (Copy(Line, 1, 19) = 'Stop in this sector') or (Copy(Line, 1, 21) = 'Engage the Autopilot?') then
+  begin
+    // Save current sector if not done already
+    if not (FSectorSaved) then
+      SectorCompleted;
+
+    // No displays anymore, all done
+    FCurrentDisplay := dNone;
+  end
+  else if (Copy(Line, 1, 2) = ': ') then
+  begin
+    // at the CIM prompt
+    if (FCurrentDisplay <> dCIM) then
+      FCurrentDisplay := dNone;
+
+    FLastWarp := 0;
+  end;
+
+  TWXInterpreter.TextEvent(CurrentLine, FALSE);
+end;
+
+procedure TModExtractor.AddWarp(SectNum, Warp : Integer);
+var
+  S     : TSector;
+  I,
+  X,
+  Pos   : Integer;
+begin
+  // Used by ProcessWarpLine to add a warp to a sector
+
+  S := TWXDatabase.LoadSector(SectNum);
+
+  // see if the warp is already in there
+  for I := 1 to 6 do
+    if (S.Warp[I] = Warp) then
+      Exit;
+
+  // find where it should fit
+  Pos := 7;
+  for I := 1 to 6 do
+    if (S.Warp[I] > Warp) or (S.Warp[I] = 0) then
+    begin
+      Pos := I;
+      Break;
+    end;
+
+  if (Pos = 1) then
+    X := 2
+  else
+    X := Pos;
+
+  // move them all up one
+  if (Pos < 6) then
+    for I := 6 downto X do
+      S.Warp[I] := S.Warp[I - 1];
+
+  if (Pos < 7) then
+    S.Warp[Pos] := Warp;
+
+  if (S.Explored = etNo) then
+  begin
+    S.Constellation := '???' + ANSI_9 + ' (warp calc only)';
+    S.Explored := etCalc;
+    S.Update := Now;
+  end;
+
+  TWXDatabase.SaveSector(S, SectNum, nil, nil, nil);
+end;
+
+procedure TModExtractor.ProcessWarpLine(Line : String);
+var
+  I,
+  CurSect,
+  LastSect : Integer;
+  S        : String;
+begin
+  // A WarpLine is a line of warps plotted using the ship's computer.  Add new warps to
+  // any sectors listed in the warp lane (used extensively for ZTM).
+  // e.g:  3 > 300 > 5362 > 13526 > 149 > 434
+
+  LastSect := FLastWarp;
+  StripChar(Line, ')');
+  StripChar(Line, '(');
+
+  I := 1;
+  S := GetParameter(Line, I);
+
+  while (S <> '') do
+  begin
+    if (S <> '>') then
+    begin
+      CurSect := StrToIntSafe(S);
+
+      if (CurSect < 1) or (CurSect > TWXDatabase.DBHeader.Sectors) then
+        // doesn't look like this line is what we thought it was.
+        // Best to leave it alone
+        exit;
+
+      if (LastSect > 0) then
+        AddWarp(LastSect, CurSect);
+
+      LastSect := CurSect;
+      FLastWarp := CurSect;
+    end;
+
+    Inc(I);
+    S := GetParameter(Line, I);
+  end;
+end;
+
+procedure TModExtractor.ProcessCIMLine(Line : String);
+  function GetCIMValue(M : String; Num : Integer) : Integer;
+  var
+    S : String;
+  begin
+    S := GetParameter(M, Num);
+
+    if (S = '') then
+      Result := 0
+    else
+    try
+      Result := StrToInt(S);
+    except
+      Result := -1;
+    end;
+  end;
+var
+  Sect   : Integer;
+  S      : TSector;
+  X,
+  I,
+  Len,
+  Ore,
+  Org,
+  Equip,
+  POre,
+  POrg,
+  PEquip : Integer;
+  M      : String;
+begin
+  if (FCurrentDisplay = dWarpCIM) then
+  begin
+    // save warp CIM data
+    Sect := GetCIMValue(Line, 1);
+
+    if (Sect <= 0) or (Sect > TWXDatabase.DBHeader.Sectors) then
+    begin
+      FCurrentDisplay := dNone;
+      Exit;
+    end;
+
+    S := TWXDatabase.LoadSector(Sect);
+
+    for I := 1 to 6 do
+    begin
+      X := GetCIMValue(Line, I + 1);
+
+      if (X < 0) or (X > TWXDatabase.DBHeader.Sectors) then
+      begin
+        FCurrentDisplay := dNone;
+        Exit;
+      end
+      else
+        S.Warp[I] := X;
+    end;
+
+    if (S.Explored = etNo) then
+    begin
+      S.Constellation := '???' + ANSI_9 + ' (warp calc only)';
+      S.Explored := etCalc;
+      S.Update := Now;
+    end;
+
+    TWXDatabase.SaveSector(S, Sect, nil, nil, nil);
+  end
+  else
+  begin
+    // save port CIM data
+    Sect := GetCIMValue(Line, 1);
+    Len := Length(IntToStr(TWXDatabase.DBHeader.Sectors));
+
+    if (Sect <= 0) or (Sect > TWXDatabase.DBHeader.Sectors) or (Length(Line) < Len + 36) then
+    begin
+      FCurrentDisplay := dNone;
+      Exit;
+    end;
+
+    M := StringReplace(Line, '-', '', [rfReplaceAll]);
+    M := StringReplace(M, '%', '', [rfReplaceAll]);
+    S := TWXDatabase.LoadSector(Sect);
+
+    Ore := GetCIMValue(M, 2);
+    Org := GetCIMValue(M, 4);
+    Equip := GetCIMValue(M, 6);
+    POre := GetCIMValue(M, 3);
+    POrg := GetCIMValue(M, 5);
+    PEquip := GetCIMValue(M, 7);
+
+    if (Ore < 0) or (Org < 0) or (Equip < 0)
+     or (POre < 0) or (POre > 100)
+     or (POrg < 0) or (POrg > 100)
+     or (PEquip < 0) or (PEquip > 100) then
+    begin
+      FCurrentDisplay := dNone;
+      Exit;
+    end;
+
+    S.SPort.ProductAmount[ptFuelOre] := Ore;
+    S.SPort.ProductAmount[ptOrganics] := Org;
+    S.SPort.ProductAmount[ptEquipment] := Equip;
+    S.SPort.ProductPercent[ptFuelOre] := POre;
+    S.SPort.ProductPercent[ptOrganics] := POrg;
+    S.SPort.ProductPercent[ptEquipment] := PEquip;
+    S.SPort.UpDate := Now;
+
+    if (S.SPort.Name = '') then
+    begin
+      // port not saved/seen before - get its details
+
+      if (Line[Len + 2] = '-') then
+        S.SPort.BuyProduct[ptFuelOre] := TRUE
+      else
+        S.SPort.BuyProduct[ptFuelOre] := FALSE;
+
+      if (Line[Len + 14] = '-') then
+        S.SPort.BuyProduct[ptOrganics] := TRUE
+      else
+        S.SPort.BuyProduct[ptOrganics] := FALSE;
+
+      if (Line[Len + 26] = '-') then
+        S.SPort.BuyProduct[ptEquipment] := TRUE
+      else
+        S.SPort.BuyProduct[ptEquipment] := FALSE;
+
+      if (S.SPort.BuyProduct[ptFuelOre]) and (S.SPort.BuyProduct[ptOrganics]) and (S.SPort.BuyProduct[ptEquipment]) then
+        S.SPort.ClassIndex := 8
+      else if (S.SPort.BuyProduct[ptFuelOre]) and (S.SPort.BuyProduct[ptOrganics]) and not (S.SPort.BuyProduct[ptEquipment]) then
+        S.SPort.ClassIndex := 1
+      else if (S.SPort.BuyProduct[ptFuelOre]) and not (S.SPort.BuyProduct[ptOrganics]) and (S.SPort.BuyProduct[ptEquipment]) then
+        S.SPort.ClassIndex := 2
+      else if not (S.SPort.BuyProduct[ptFuelOre]) and (S.SPort.BuyProduct[ptOrganics]) and (S.SPort.BuyProduct[ptEquipment]) then
+        S.SPort.ClassIndex := 3
+      else if not (S.SPort.BuyProduct[ptFuelOre]) and not (S.SPort.BuyProduct[ptOrganics]) and (S.SPort.BuyProduct[ptEquipment]) then
+        S.SPort.ClassIndex := 4
+      else if not (S.SPort.BuyProduct[ptFuelOre]) and (S.SPort.BuyProduct[ptOrganics]) and not (S.SPort.BuyProduct[ptEquipment]) then
+        S.SPort.ClassIndex := 5
+      else if (S.SPort.BuyProduct[ptFuelOre]) and not (S.SPort.BuyProduct[ptOrganics]) and not (S.SPort.BuyProduct[ptEquipment]) then
+        S.SPort.ClassIndex := 6
+      else if not (S.SPort.BuyProduct[ptFuelOre]) and not (S.SPort.BuyProduct[ptOrganics]) and not (S.SPort.BuyProduct[ptEquipment]) then
+        S.SPort.ClassIndex := 7;
+
+      S.SPort.Name := '???';
+    end;
+
+    if (S.Explored = etNo) then
+    begin
+      S.Constellation := '???' + ANSI_9 + ' (port data/calc only)';
+      S.Explored := etCalc;
+      S.Update := Now;
+    end;
+
+    TWXDatabase.SaveSector(S, Sect, nil, nil, nil);
+  end;
+end;
+
+procedure TModExtractor.ProcessSectorLine(Line : String);
+var
+  S         : String;
+  I         : Integer;
+  NewPlanet : PPlanet;
+  NewShip   : PShip;
+  NewTrader : PTrader;
+begin
+  if (Copy(Line, 1, 10) = 'Beacon  : ') then
+  begin
+    // Get beacon text
+    FCurrentSector.Beacon := Copy(Line, 11, length(Line) - 10);
+  end
+  else if (Copy(Line, 1, 10) = 'Ports   : ') then
+  begin
+    // Save port data
+
+    if (Pos('<=-DANGER-=>', Line) > 0) then
+      // Port is destroyed
+      FCurrentSector.SPort.Dead := TRUE
+    else
+    begin
+      FCurrentSector.SPort.Dead := FALSE;
+      FCurrentSector.SPort.BuildTime := 0;
+      FCurrentSector.SPort.Name := Copy(Line, 11, Pos(', Class', Line) - 11);
+      FCurrentSector.SPort.ClassIndex := StrToIntSafe(Copy(Line, Pos(', Class', Line) + 8, 1));
+
+      if (Line[length(Line) - 3] = 'B') then
+        FCurrentSector.SPort.BuyProduct[ptFuelOre] := TRUE
+      else
+        FCurrentSector.SPort.BuyProduct[ptFuelOre] := FALSE;
+
+      if (Line[length(Line) - 2] = 'B') then
+        FCurrentSector.SPort.BuyProduct[ptOrganics] := TRUE
+      else
+        FCurrentSector.SPort.BuyProduct[ptOrganics] := FALSE;
+
+      if (Line[length(Line) - 1] = 'B') then
+        FCurrentSector.SPort.BuyProduct[ptEquipment] := TRUE
+      else
+        FCurrentSector.SPort.BuyProduct[ptEquipment] := FALSE;
+    end;
+
+    FSectorPosition := spPorts;
+  end
+  else if (Copy(Line, 1, 10) = 'Planets : ') then
+  begin
+    // Get planet data
+    NewPlanet := AllocMem(SizeOf(TPlanet));
+    TWXDatabase.NULLPlanet(NewPlanet^);
+    NewPlanet^.Name := Copy(Line, 11, length(Line) - 10);
+    FPlanetList.Add(NewPlanet);
+
+    FSectorPosition := spPlanets;
+  end
+  else if (Copy(Line, 1, 10) = 'Traders : ') then
+  begin
+    // Save traders
+    I := Pos(', w/', Line);
+    FCurrentTrader.Name := Copy(Line, 11, I - 11);
+    S := Copy(Line, I + 5, Pos(' ftrs', Line) - I - 5);
+    StripChar(S, ',');
+    FCurrentTrader.Figs := StrToIntSafe(S);
+    FSectorPosition := spTraders;
+  end
+  else if (Copy(Line, 1, 10) = 'Ships   : ') then
+  begin
+    // Save ships
+    I := Pos('[Owned by]', Line);
+    FCurrentShip.Name := Copy(Line, 11, I - 12);
+    FCurrentShip.Owner := Copy(Line, I + 11, Pos(', w/', Line) - I - 11);
+    I := Pos(', w/', Line);
+    S := Copy(Line, I + 5, Pos(' ftrs,', Line) - I - 5);
+    StripChar(S, ',');
+    FCurrentShip.Figs := StrToIntSafe(S);
+    FSectorPosition := spShips;
+  end
+  else if (Copy(Line, 1, 10) = 'Fighters: ') then
+  begin
+    // Get fig details
+    S := GetParameter(Line, 2);
+    StripChar(S, ',');
+    FCurrentSector.Figs.Quantity := StrToIntSafe(S);
+    I := GetParameterPos(Line, 3) + 1;
+    FCurrentSector.Figs.Owner := Copy(Line, I, Pos(')', Line) - I);
+
+    if (Copy(Line, length(Line) - 5, 6) = '[Toll]') then
+      FCurrentSector.Figs.FigType := ftToll
+    else if (Copy(Line, length(Line) - 10, 11) = '[Defensive]') then
+      FCurrentSector.Figs.FigType := ftDefensive
+    else
+      FCurrentSector.Figs.FigType := ftOffensive;
+  end
+  else if (Copy(Line, 1, 10) = 'NavHaz  : ') then
+  begin
+    S := GetParameter(Line, 3);
+    S := Copy(S, 1, length(S) - 1);
+    FCurrentSector.NavHaz := StrToIntSafe(S);
+  end
+  else if (Copy(Line, 1, 10) = 'Mines   : ') then
+  begin
+    // Save mines
+    FSectorPosition := spMines;
+    I := GetParameterPos(Line, 7) + 1;
+    S := Copy(Line, I, length(Line) - I);
+
+    if (GetParameter(Line, 6) = 'Armid)') then
+    begin
+      FCurrentSector.Mines_Armid.Quantity := StrToIntSafe(GetParameter(Line, 3));
+      FCurrentSector.Mines_Armid.Owner := S;
+    end
+    else
+    begin
+      FCurrentSector.Mines_Limpet.Quantity := StrToIntSafe(GetParameter(Line, 3));
+      FCurrentSector.Mines_Limpet.Owner := S;
+    end;
+  end
+  else if (Copy(Line, 1, 8) = '        ') then
+  begin
+    // Continue from last occurance
+
+    if (FSectorPosition = spMines) then
+    begin
+      I := GetParameterPos(Line, 6) + 1;
+      FCurrentSector.Mines_Limpet.Quantity := StrToIntSafe(GetParameter(Line, 2));
+      FCurrentSector.Mines_Limpet.Owner := Copy(Line, I, length(Line) - I);
+    end
+    else if (FSectorPosition = spPorts) then
+      FCurrentSector.SPort.BuildTime := StrToIntSafe(GetParameter(Line, 4))
+    else if (FSectorPosition = spPlanets) then
+    begin
+      // Get planet data
+      NewPlanet := AllocMem(SizeOf(TPlanet));
+      TWXDatabase.NULLPlanet(NewPlanet^);
+      NewPlanet^.Name := Copy(Line, 11, length(Line) - 10);
+      FPlanetList.Add(NewPlanet);
+    end
+    else if (FSectorPosition = spTraders) then
+    begin
+      if (GetParameter(Line, 1) = 'in') then
+      begin
+        // Still working on one trader
+        NewTrader := AllocMem(SizeOf(TTrader));
+        I := GetParameterPos(Line, 2);
+        NewTrader^.ShipName := Copy(Line, I, Pos('(', Line) - I - 1);
+        I := Pos('(', Line);
+        NewTrader^.ShipType := Copy(Line, I + 1, Pos(')', Line) - I - 1);
+        NewTrader^.Name := FCurrentTrader.Name;
+        NewTrader^.Figs := FCurrentTrader.Figs;
+        FTraderList.Add(NewTrader);
+      end
+      else
+      begin
+        // New trader
+        I := Pos(', w/', Line);
+        FCurrentTrader.Name := Copy(Line, 11, I - 11);
+        S := Copy(Line, I + 5, Pos(' ftrs', Line) - I - 5);
+        StripChar(S, ',');
+        FCurrentTrader.Figs := StrToIntSafe(S);
+      end;
+    end
+    else if (FSectorPosition = spShips) then
+    begin
+      if (Copy(Line, 12, 1) = '(') then
+      begin
+        // Get the rest of the ship info
+        NewShip := AllocMem(SizeOf(TShip));
+        NewShip^.Name := FCurrentShip.Name;
+        NewShip^.Owner := FCurrentShip.Owner;
+        NewShip^.Figs := FCurrentShip.Figs;
+        NewShip^.ShipType := Copy(Line, 13, Pos(')', Line) - 13);
+        FShipList.Add(NewShip);
+      end
+      else
+      begin
+        // New ship
+        I := Pos('[Owned by]', Line);
+        FCurrentShip.Name := Copy(Line, 11, I - 12);
+        FCurrentShip.Owner := Copy(Line, I + 11, Pos(', w/', Line) - I - 11);
+        I := Pos(', w/', Line);
+        S := Copy(Line, I + 5, Pos(' ftrs,', Line) - I - 5);
+        StripChar(S, ',');
+        FCurrentShip.Figs := StrToIntSafe(S);
+        FSectorPosition := spShips;
+      end;
+    end;
+  end
+  else if (Copy(Line, 9, 1) = ':') then
+    FSectorPosition := spNormal  
+  else if (Copy(Line, 1, 20) = 'Warps to Sector(s) :') then
+  begin
+    StripChar(Line, '(');
+    StripChar(Line, ')');
+
+    // Get sector warps
+    FCurrentSector.Warp[1] := StrToIntSafe(GetParameter(Line, 5));
+    FCurrentSector.Warp[2] := StrToIntSafe(GetParameter(Line, 7));
+    FCurrentSector.Warp[3] := StrToIntSafe(GetParameter(Line, 9));
+    FCurrentSector.Warp[4] := StrToIntSafe(GetParameter(Line, 11));
+    FCurrentSector.Warp[5] := StrToIntSafe(GetParameter(Line, 13));
+    FCurrentSector.Warp[6] := StrToIntSafe(GetParameter(Line, 15));
+
+    // sector done
+    if not (FSectorSaved) then
+      SectorCompleted;
+
+    // No displays anymore, all done
+    FCurrentDisplay := dNone;
+    FSectorPosition := spNormal;
+  end;
+end;
+
+procedure TModExtractor.ProcessPortLine(Line : String);
+begin
+  // Process a line from the CR port display
+end;
+
+procedure TModExtractor.ProcessLine(Line : String);
+var
+  S,
+  X       : String;
+  I       : Integer;
+  Sect    : TSector;
+begin
+  // Every line is passed to this procedure to be processed and recorded
+
+  if (FCurrentMessage <> '') then
+  begin
+    if (Line <> '') then
+    begin
+      if (FCurrentMessage = 'Figs') then
+        TWXGUI.AddToHistory(htFighter, TimeToStr(Time) + '  ' + StripChars(Line))
+      else if (FCurrentMessage = 'Comp') then
+        TWXGUI.AddToHistory(htComputer, TimeToStr(Time) + '  ' + StripChars(Line))
+      else
+        TWXGUI.AddToHistory(htMsg, TimeToStr(Time) + '  ' + StripChars(Line));
+
+      FCurrentMessage := '';
+    end;
+  end
+  else if (Copy(Line, 1, 2) = 'R ') or (Copy(Line, 1, 2) = 'F ') then
+    TWXGUI.AddToHistory(htMsg, TimeToStr(Time) + '  ' + StripChars(Line))
+  else if (Copy(Line, 1, 2) = 'P ') then
+  begin
+    if (GetParameter(Line, 2) <> 'indicates') then
+      TWXGUI.AddToHistory(htMsg, TimeToStr(Time) + '  ' + StripChars(Line))
+  end
+  else if (Copy(Line, 1, 26) = 'Incoming transmission from') or (Copy(Line, 1, 28) = 'Continuing transmission from') then
+  begin
+    // Transmission with ansi off
+    I := GetParameterPos(Line, 4);
+
+    if (Copy(Line, Length(Line) - 9, 10) = 'comm-link:') then
+    begin
+      // Fedlink
+      FCurrentMessage := 'F ' + Copy(Line, I, Pos(' on Federation', Line) - I) + ' ';
+    end
+    else if (GetParameter(Line, 5) = 'Fighters:') then
+    begin
+      // Fighters
+      FCurrentMessage := 'Figs';
+    end
+    else if (GetParameter(Line, 5) = 'Computers:') then
+    begin
+      // Computer
+      FCurrentMessage := 'Comp';
+    end
+    else if (Pos(' on channel ', Line) <> 0) then
+    begin
+      // Radio
+      FCurrentMessage := 'R ' + Copy(Line, I, Pos(' on channel ', Line) - I) + ' ';
+    end
+    else
+    begin
+      // hail
+      FCurrentMessage := 'P ' + Copy(Line, I, Length(Line) - I) + ' ';
+    end
+  end
+  else if (Copy(Line, 1, 31) = 'Deployed Fighters Report Sector') then
+    TWXGUI.AddToHistory(htFighter, TimeToStr(Time) + '  ' + Copy(Line, 19, Length(Line)))
+  else if (Copy(Line, 1, 20) = 'Shipboard Computers ') then
+    TWXGUI.AddToHistory(htComputer, TimeToStr(Time) + '  ' + Copy(Line, 21, Length(Line)))
+  else if (Copy(Line, 1, 19) = 'The shortest path (') or (Copy(Line, 1, 7) = '  TO > ') then
+  begin
+    FCurrentDisplay := dWarpLane;
+    FLastWarp := 0;
+  end
+  else if (FCurrentDisplay = dWarpLane) then
+    ProcessWarpLine(Line)
+  else if (FCurrentDisplay = dWarpCIM) or (FCurrentDisplay = dPortCIM) then
+    ProcessCIMLine(Line)
+  else if (FCurrentDisplay = dCIM) then
+  begin
+    // find out what kind of CIM this is
+    if (Length(Line) > 2) then
+    begin
+      if (Line[Length(Line) - 1] = '%') then
+      begin
+        TWXDatabase.LastPortCIM := Now;
+        FCurrentDisplay := dPortCIM;
+      end
+      else
+        FCurrentDisplay := dWarpCIM;
+
+      ProcessCIMLine(Line);
+    end;
+  end
+  else if (Copy(Line, 1, 10) = 'Sector  : ') then
+  begin
+    // Check if this is a probe or holoscan (no warp pickup)
+    if not (FSectorSaved) then
+      SectorCompleted;
+
+    // Begin recording of sector data
+    FCurrentDisplay := dSector;
+    FSectorSaved := FALSE;
+
+    // Clear sector variables
+    TWXDatabase.NULLSector(FCurrentSector);
+
+    FCurrentSectorIndex := StrToIntSafe(GetParameter(Line, 3));
+    I := GetParameterPos(Line, 5);
+    FCurrentSector.Constellation := Copy(Line, I, length(Line) - I + 1);
+  end
+  else if (FCurrentDisplay = dSector) then
+    ProcessSectorLine(Line)
+  else if (FCurrentDisplay = dPort) then
+    ProcessPortLine(Line)
+  else if (Copy(Line, 27, 16) = 'Relative Density') then
+  begin
+    // A density scanner is being used - lets grab some data
+    FCurrentDisplay := dDensity;
+  end
+  else if (FCurrentDisplay = dDensity) and (Copy(Line, 1, 6) = 'Sector') then
+  begin
+    // Save all density data into sector database
+    X := Line;
+    StripChar(X, '(');
+    StripChar(X, ')');
+    I := StrToIntSafe(GetParameter(X, 2));
+    Sect := TWXDatabase.LoadSector(I);
+    S := GetParameter(X, 4);
+    StripChar(S, ',');
+    Sect.Density := StrToIntSafe(S);
+
+    if (GetParameter(X, 13) = 'Yes') then
+      // Sector has anomoly
+      Sect.Anomoly := TRUE
+    else
+      Sect.Anomoly := FALSE;
+
+    S := GetParameter(X, 10);
+    S := Copy(S, 1, length(S) - 1);
+    Sect.NavHaz := StrToIntSafe(S);
+
+    Sect.Warps := StrToIntSafe(GetParameter(X, 7));
+
+    if (Sect.Explored in [etNo, etCalc]) then
+    begin
+      // Sector hasn't been scanned or seen before
+      Sect.Constellation := '???' + ANSI_9 + ' (Density only)';
+      Sect.Explored := etDensity;
+      Sect.Update := Now;
+    end;
+
+    TWXDatabase.SaveSector(Sect, I, nil, nil, nil);
+  end
+  else if (Copy(Line, 1, 28) = 'What sector is the port in? ') then
+  begin
+    // begin port data download
+
+  end
+  else if (Copy(Line, 1, 2) = ': ') then
+  begin
+    // begin CIM download
+    FCurrentDisplay := dCIM;
+  end;
+
+  TWXInterpreter.TextLineEvent(Line, FALSE);
+  ProcessPrompt(Line);
+
+  // Reactivate script triggers
+  TWXInterpreter.ActivateTriggers;
+end;
+
+procedure TModExtractor.StripANSI(var S : String);
+var
+  I    : Integer;
+  X    : String;
+begin
+  // Remove ANSI codes from text
+  X := '';
+
+  for I := 1 to length(S) do
+  begin
+    if (S[I] = #27) then
+      FInAnsi := TRUE;
+
+    if (FInAnsi = FALSE) then
+      X := X + S[I];
+
+    if ((Byte(S[I]) >= 65) and (Byte(S[I]) <= 90)) or ((Byte(S[I]) >= 97) and (Byte(S[I]) <= 122)) then
+      FInAnsi := FALSE;
+  end;
+
+  S := X;
+end;
+
+procedure TModExtractor.ProcessInBound(var InData : String);
+var
+  X        : Integer;
+  I        : Integer;
+  S,
+  ANSIS,
+  ANSILine,
+  Line     : string;
+begin
+  S := InData;
+
+  // Remove null chars
+  StripChar(S, #0);
+
+  // strip the ANSI
+  AnsiS := S;
+  StripANSI(S);
+
+  TWXLog.DoLogData(S, InData);
+
+  // Remove linefeed
+  StripChar(S, #10);
+  StripChar(AnsiS, #10);
+
+  // Form and process lines out of data
+  I := 1;
+  Line := CurrentLine + S;
+  AnsiLine := CurrentANSILine + AnsiS;
+
+  while (I <= Length(Line)) do
+  begin
+    if (Line[I] = #13) then
+    begin
+      // find the matching carriage return in the ansi line
+      X := 1;
+      
+      if (Length(ANSILine) > 0) then
+        while (ANSILine[X] <> #13) and (X < Length(ANSILine)) do
+          Inc(X);
+
+      CurrentLine := Copy(Line, 1, I - 1);
+      CurrentANSILine := Copy(ANSILine, 1, X - 1);
+      ProcessLine(CurrentLine);
+
+      if (I < Length(Line)) then
+      begin
+        Line := Copy(Line, I + 1, Length(Line) - I);
+        ANSILine := Copy(ANSILine, X + 1, Length(ANSILine) - X);
+      end
+      else
+      begin
+        Line := '';
+        ANSILine := '';
+        Break;
+      end;
+
+      I := 0;
+    end;
+
+    Inc(I);
+  end;
+
+  // Process what we have left
+  CurrentLine := Line;
+  CurrentANSILine := ANSILine;
+  ProcessPrompt(CurrentLine);
+
+end;
+
+
+
+// ********************************************************************
+// Process outbound data
+
+
+
+function TModExtractor.ProcessOutBound(OutData : string; ClientIndex : Byte) : Boolean;
+begin
+  Result := TRUE;
+
+  if (OutData[1] = MenuKey) and (TWXMenu.CurrentMenu = nil) then
+  begin
+    // Activate menu
+
+    if not (TWXClient.Connected) then
+    begin
+      // User trying to access database while not connected
+
+      if not (TWXDatabase.DataBaseOpen) then
+        TWXServer.ClientMessage(endl + ANSI_12 + 'Warning: This database is corrupt or does not exist.  No data is available.' + ANSI_7 + endl);
+    end;
+
+    TWXMenu.OpenMenu('TWX_MAIN', ClientIndex);
+
+    // run the rest of the text through the menus
+    if (Length(OutData) > 1) then
+      ProcessOutBound(Copy(OutData, 2, Length(OutData)), ClientIndex);
+
+    Result := FALSE;
+  end
+  else if (TWXMenu.CurrentMenu <> nil) then
+  begin
+    if (OutData[1] = MenuKey) then
+      // De-activate menu
+      TWXMenu.CloseMenu(TRUE)
+    else
+      // Send commands to menu
+      TWXMenu.MenuText(OutData, ClientIndex);
+
+    Result := FALSE;
+  end;
+
+  // don't return a value if trigger had this key
+  if (Result) and (OutData <> '') then
+    Result := not TWXInterpreter.TextOutEvent(OutData, nil);
+end;
+
+end.
+
+
+