unit bi_db;

interface

uses

SysUtils, Classes, Dialogs, bi_hash, bi_threads, bi_currency, bi_delphi,

bi_binaryset;

const

SPECIALCHARS : set of char = ['.','/','!','@','#','$','%','^','&','*','''','"',';','_','(',')',':','|','[',']'];

BLDATATYPE = 'BL';

BLHOST = 'bricklink.com';

MAXBRICKLINKCOLOR = 256;

MAXINFOCOLOR = 9999;

NOACTIONCAPTION = 'Nothing to do';

MINYEAR = 1932;

type

sourcetype_t = (stUnsuported ,stBrickLink ,stRebrickable ,stLDCad ,stLDraw);

colorinfo_t = record

id: integer;

name: string[24];

RGB: LongWord;

nParts: integer;

nSets: integer;

fYear: integer;

yYear: integer;

legoColor: string[24];

ldrawColor: integer;

BrickLinkColor: integer;

PeeronColor: string[24];

alternateid: integer;

knownpieces: THashStringList;

end;

colorinfo_p = ^colorinfo_t;

colorinfoarray_t = array[-1..MAXINFOCOLOR] of colorinfo_t;

colorinfoarray_p = ^colorinfoarray_t;

type

progressfunc_t = procedure (const s: string; a: double) of object;

brickpool_t = record

part: string[15];

color: integer;

num: integer;

end;

brickpool_p = ^brickpool_t;

brickpool_a = array[0..$FFFF] of brickpool_t;

brickpool_pa = ^brickpool_a;

set_t = record

setid: string[15];

num: integer;

dismantaled: integer;

end;

set_p = ^set_t;

set_a = array[0..$FFFF] of set_t;

set_pa = ^set_a;

type

partout_t = record

percentage: Double;

value: Double;

end;

const

B_HASHSIZE = $FFF;

type

bhashitem_t = record

position: integer;

end;

bhashtable_t = array[0..B_HASHSIZE] of bhashitem_t;

type

brickstatshistory_t = record

time: TDateTime;

Sold_nAvg: partout_t;

Sold_nQtyAvg: partout_t;

Sold_uAvg: partout_t;

Sold_uQtyAvg: partout_t;

Avail_nAvg: partout_t;

Avail_nQtyAvg: partout_t;

Avail_uAvg: partout_t;

Avail_uQtyAvg: partout_t;

nDemand: partout_t;

uDemand: partout_t;

end;

type

pieceinventoryhistory_t = record

time: TDateTime;

nnew: integer;

nused: integer;

nbuilded: integer;

ndismantaled: integer;

end;

type

TBrickInventory = class(TObject)

private

flooseparts: brickpool_pa;

bhash: bhashtable_t;

fsets: set_pa;

fneedsReorganize: boolean;

fnumlooseparts: integer;

fnumsets: integer;

frealnumlooseparts: integer;

frealnumsets: integer;

fupdatetime: TDateTime;

fupdatetimeout: double;

fSoldPartOutValue_nAvg: partout_t;

fSoldPartOutValue_nQtyAvg: partout_t;

fSoldPartOutValue_uAvg: partout_t;

fSoldPartOutValue_uQtyAvg: partout_t;

fAvailablePartOutValue_nAvg: partout_t;

fAvailablePartOutValue_nQtyAvg: partout_t;

fAvailablePartOutValue_uAvg: partout_t;

fAvailablePartOutValue_uQtyAvg: partout_t;

procedure _growparts;

procedure _growsets;

protected

procedure AddLoosePartFast(const part: string; color: integer; num: integer);

public

constructor Create; virtual;

destructor Destroy; override;

function LoadLooseParts(const fname: string): boolean;

function LoadSets(const fname: string): boolean;

procedure SaveLooseParts(const fname: string);

procedure SaveLoosePartsWantedListNew(const fname: string; const pricefactor: Double = 1.0; const wl: Integer = 0);

procedure SaveLoosePartsWantedListUsed(const fname: string; const pricefactor: Double = 1.0; const wl: Integer = 0);

procedure SavePartsInventoryPriceguide(const fname: string);

procedure SaveSets(const fname: string);

procedure AddLoosePart(const part: string; color: integer; num: integer);

function RemoveLoosePart(const part: string; color: integer; num: integer): boolean;

function LoosePartCount(const part: string; color: integer): integer;

procedure AddSet(const setid: string; dismantaled: boolean);

procedure GetSetInfo(const setid: string; const s: set_p);

function RemoveSet(const setid: string; dismantaled: boolean): boolean;

function DismandalSet(const setid: string): boolean;

function DismandalAllSets: boolean;

function BuildSet(const setid: string): boolean;

function BuildAllSets: boolean;

function CanBuildSet(const setid: string): boolean;

function MissingToBuildSet(const setid: string): integer;

function InventoryForMissingToBuildSet(const setid: string; const nsets: integer = 1): TBrickInventory;

function CanBuildInventory(const inv: TBrickInventory): boolean;

function MissingToBuildInventory(const inv: TBrickInventory): integer;

function InventoryForMissingToBuildInventory(const inv: TBrickInventory): TBrickInventory;

function LoosePartsWeight: double;

procedure UpdateCostValues;

procedure DoUpdateCostValues;

function SoldPartOutValue_nAvg: partout_t;

function SoldPartOutValue_nQtyAvg: partout_t;

function SoldPartOutValue_uAvg: partout_t;

function SoldPartOutValue_uQtyAvg: partout_t;

function AvailablePartOutValue_nAvg: partout_t;

function AvailablePartOutValue_nQtyAvg: partout_t;

function AvailablePartOutValue_uAvg: partout_t;

function AvailablePartOutValue_uQtyAvg: partout_t;

function nDemand: partout_t;

function uDemand: partout_t;

procedure Reorganize;

procedure Clear;

procedure MergeWith(const inv: TBrickInventory);

function Clone: TBrickInventory;

function numlotsbycolor(const col: integer): integer;

function numlotsbycatcolor(const col: integer; const cat: integer): integer;

function numlotsbypart(const pt: string): integer;

function numlotsbycategory(const cat: integer): integer;

function totalloosepartsbycolor(const col: integer): integer;

function totalloosepartsbycatcolor(const col: integer; const cat: integer): integer;

function totalloosepartsbypart(const pt: string): integer;

function totalloosepartsbycategory(const cat: integer): integer;

function weightbycategory(const cat: integer): double;

function weightbycolor(const col: integer): double;

function weightbycatcolor(const col: integer; const cat: integer): double;

function totallooseparts: integer;

function totalsetsbuilted: integer;

function totalsetsdismantaled: integer;

function GetMoldList: TStringList;

function GetDismandaledSets: TStringList;

function GetHistoryStatsRec: brickstatshistory_t;

procedure StoreHistoryStatsRec(const fn: string; const pl: integer = 0);

function GetPieceInventoryStatsRec(const piece: string; const color: integer): pieceinventoryhistory_t;

procedure StorePieceInventoryStatsRec(const fn: string; const piece: string; const color: integer; const pl: integer = 0);

procedure SortPieces;

property numlooseparts: integer read fnumlooseparts;

property looseparts: brickpool_pa read flooseparts;

property numsets: integer read fnumsets;

property sets: set_pa read fsets;

property updatetimeout: double read fupdatetimeout write fupdatetimeout;

end;

type

categoryinfo_t = record

name: string[32];

knownpieces: THashStringList;

end;

categoryinfo_p = ^categoryinfo_t;

const

MAXCATEGORIES = 1024;

type

categoryinfoarray_t = array[0..MAXCATEGORIES - 1] of categoryinfo_t;

categoryinfoarray_p = ^categoryinfoarray_t;

type

TPieceInfo = class(TObject)

public

desc: string;

category: integer;

weight: Double;

dimentionx: Double;

dimentiony: Double;

dimentionz: Double;

constructor Create; virtual;

end;

type

TSetExtraInfo = class(TObject)

public

text: string;

year: integer;

moc: boolean;

similars: string;

end;

TString = class(TObject)

public

text: string;

end;

type

priceguide_t = record

nTimesSold: integer;

nTotalQty: integer;

nMinPrice: double;

nAvgPrice: double;

nQtyAvgPrice: double;

nMaxPrice: double;

uTimesSold: integer;

uTotalQty: integer;

uMinPrice: double;

uAvgPrice: double;

uQtyAvgPrice: double;

uMaxPrice: double;

end;

priceguide_p = ^priceguide_t;

availability_t = record

nTotalLots: integer;

nTotalQty: integer;

nMinPrice: double;

nAvgPrice: double;

nQtyAvgPrice: double;

nMaxPrice: double;

uTotalLots: integer;

uTotalQty: integer;

uMinPrice: double;

uAvgPrice: double;

uQtyAvgPrice: double;

uMaxPrice: double;

end;

availability_p = ^availability_t;

parec_t = record

priceguide: priceguide_t;

availability: availability_t;

end;

parecdate_t = record

priceguide: priceguide_t;

availability: availability_t;

date: TDateTime;

end;

parecdate_p = ^parecdate_t;

TPieceColorInfo = class(TObject)

private

fneedssave: boolean;

fhasloaded: boolean;

fhash: LongWord;

fpriceguide: priceguide_t;

favailability: availability_t;

fappearsinsets: integer; // In how many sets appears?

fappearsinsetstotal: integer; // How many pieces in all set?

fpiece: string;

fcolor: integer;

fcolorstr: string;

fsets: TStringList;

fstorage: TStringList;

fdate: TDateTime;

fsetmost: string;

fsetmostnum: integer;

public

constructor Create(const apiece: string; const acolor: integer); virtual;

destructor Destroy; override;

procedure Assign(const pg: priceguide_t); overload;

procedure Assign(const av: availability_t); overload;

function Check: boolean;

procedure AddSetReference(const aset: string; const numpieces: integer);

function LoadFromDisk: boolean;

procedure Load;

procedure SaveToDisk;

procedure InternetUpdate;

function EvaluatePriceNew: double;

function EvaluatePriceUsed: double;

function dbExportString: string;

function nDemand: double;

function uDemand: double;

function ItemType: string;

property priceguide: priceguide_t read fpriceguide;

property availability: availability_t read favailability;

property appearsinsets: integer read fappearsinsets;

property appearsinsetstotal: integer read fappearsinsetstotal;

property piece: string read fpiece;

property color: integer read fcolor;

property hasloaded: boolean read fhasloaded;

property sets: TStringList read fsets;

property storage: TStringList read fstorage;

property Hash: LongWord read fhash;

property setmost: string read fsetmost;

property setmostnum: integer read fsetmostnum;

function invalid: boolean;

end;

const

CACHEDBHASHSIZE = $20000;

CACHEDBSTRINGSIZE = 16;

type

cachedbitem_t = record

partid: array[0..CACHEDBSTRINGSIZE - 1] of char;

color: integer;

parec: parecdate_t;

end;

cachedbitem_p = ^cachedbitem_t;

cachedbparec_t = array[0..CACHEDBHASHSIZE - 1] of cachedbitem_t;

cachedbparec_p = ^cachedbparec_t;

type

TSetsDatabase = class;

TCacheDB = class(TObject)

private

fname: string;

fstream: TFileStream;

parecs: cachedbparec_p;

waitlist: TDNumberList;

function OpenDB1(const mode: char): TFileStream;

protected

function TryOpenDB(const mode: char; const maxretry: integer = 10000): TFileStream; virtual;

function apart(const it: cachedbitem_p): string;

procedure Flash; virtual;

public

constructor Create(const aname: string); virtual;

procedure OpenDB(const mode: char); virtual;

procedure CloseDB; virtual;

function LoadPCI(const p: TPieceColorInfo): boolean; virtual;

function SavePCI(const p: TPieceColorInfo): boolean; virtual;

destructor Destroy; override;

end;

fpciloaderparams_t = record

db: TSetsDatabase;

end;

fpciloaderparams_p = ^fpciloaderparams_t;

TSetsDatabase = class(TObject)

private

floaded: boolean;

fallsets: THashStringList;

fallsetswithoutextra: THashStringList;

fcategories: categoryinfoarray_t;

fpieces: TStringList;

fpieceshash: THashTable;

fsets: TStringList;

fsetshash: THashTable;

fpiecesaliasBL: THashStringList;

fpiecesaliasRB: THashStringList;

fCrawlerLinks: TStringList;

fcolorpieces: TStringList;

fcrawlerpriority: TStringList;

flastcrawlpiece: string;

fstorage: TStringList;

fstubpieceinfo: TPieceInfo;

fcurrencies: TCurrency;

fcrawlerfilename: string;

fbricklinkcolortorebricablecolor: array[0..MAXBRICKLINKCOLOR - 1] of integer;

fCacheDB: TCacheDB;

fbinarysets: TBinarySetCollection;

st_pciloads: integer;

st_pciloadscache: integer;

procedure InitColors;

procedure InitCategories;

procedure InitPieces;

procedure InitPiecesAlias;

procedure InitCrawlerLinks;

procedure InitSets;

procedure InitSetReferences;

public

fcolors: colorinfoarray_t;

progressfunc: progressfunc_t;

constructor Create; virtual;

procedure InitCreate(const app: string = ''); virtual;

destructor Destroy; override;

function LoadFromDisk(const fname: string): boolean;

function SaveSetInformationToDisk: boolean;

procedure AddSetPiece(const setid: string; const part: string; const typ: string; color: integer; num: integer);

procedure AddPieceAlias(const bl, rb: string);

procedure AddCrawlerLink(const part: string; const color: integer; const link: string);

function CrawlerLink(const part: string; const color: integer): string;

function GetSetInventory(const setid: string): TBrickInventory;

function GetSetInventoryWithOutExtra(const setid: string): TBrickInventory;

procedure ReloadCache;

procedure GetCacheHashEfficiency(var hits, total: integer);

function Colors(const i: Integer): colorinfo_p;

function PieceDesc(const s: string): string;

function BrickLinkPart(const s: string): string;

function BrickLinkColorToRebrickableColor(const c: integer): integer;

function RebrickablePart(const s: string): string;

function GetDesc(const s: string): string;

function GetYear(const s: string): integer;

function GetSimilars(const s: string): string;

function IsMoc(const s: string): boolean;

function SetListAtYear(const y: integer): TStringList;

function PieceListForSets(const slist: TStringList): TStringList;

function PieceListForYear(const y: integer): TStringList;

function PieceInfo(const piece: string): TPieceInfo;

function PieceColorInfo(const piece: string; const color: integer): TPieceColorInfo;

function Priceguide(const piece: string; const color: integer = -1): priceguide_t;

function Availability(const piece: string; const color: integer = -1): availability_t;

function ConvertCurrency(const cur: string): double;

procedure CrawlerPriorityPart(const piece: string; const color: integer = -1);

procedure ExportPriceGuide(const fname: string);

procedure ExportPartOutGuide(const fname: string);

procedure Crawler;

procedure SaveStorage;

procedure LoadStorage;

function StorageBins: TStringlist;

function StorageBinsForMold(const mld: string): TStringlist;

function InventoryForStorageBin(const st: string): TBrickInventory;

function InventoryForAllStorageBins: TBrickInventory;

procedure SetPieceStorage(const piece: string; const color: integer; const st: TStringList);

function RefreshInv(const inv: TBrickInventory): boolean;

function RefreshSet(const s: string; const lite: boolean = false): boolean;

function RefreshPart(const s: string): boolean;

function UpdateSet(const s: string; const data: string = ''): boolean;

procedure UpdateExtraInfos(const str: TStrings);

function UpdateSetInformation(const ident: string; const desc: string = '';

const year: integer = 0; const ismoc: boolean = false; const conn: string = ''): boolean;

property lastcrawlpiece: string read flastcrawlpiece;

property loaded: boolean read floaded;

property categories: categoryinfoarray_t read fcategories;

property AllSets: THashStringList read fallsets;

property AllSetsWithOutExtra: THashStringList read fallsetswithoutextra;

property AllPieces: TStringList read fpieces;

property crawlerfilename: string read fcrawlerfilename write fcrawlerfilename;

property CacheDB: TCacheDB read fCacheDB;

property pciloads: integer read st_pciloads;

property pciloadscache: integer read st_pciloadscache;

property binarysets: TBinarySetCollection read fbinarysets;

end;

function PieceColorCacheDir(const piece, color: string): string;

function PieceColorCacheFName(const piece, color: string): string;

var

basedefault: string = '';

function F_nDemand(const favailability: availability_t; const fpriceguide: priceguide_t): double;

function F_uDemand(const favailability: availability_t; const fpriceguide: priceguide_t): double;

implementation

uses

bi_system, bi_utils, bi_crawler, StrUtils, bi_priceadjust, bi_tmp, bi_globals;

function MkBHash(const part: string; color: integer): Longword;

var

i: integer;

check: string;

b: byte;

begin

check := strupper(part) ',' itoa(color);

b := Ord(check[1]);

result := 5381 * 33 b;

for i := 2 to Length(check) do

begin

b := Ord(check[i]);

result := result * 33 b;

end;

result := result and $FFF;

end;

function MkPCIHash(const part: string; color: integer): Longword;

var

i: integer;

check: string;

b: byte;

begin

check := strupper(part) ',' itoa(color);

b := Ord(check[1]);

result := 5381 * 33 b;

for i := 2 to Length(check) do

begin

b := Ord(check[i]);

result := result * 33 b;

end;

result := result and (CACHEDBHASHSIZE - 1);

end;

constructor TBrickInventory.Create;

begin

inherited Create;

fupdatetime := 0.0;

fupdatetimeout := 1 / 48; // half an hour

ZeroMemory(@bhash, SizeOf(bhashtable_t));

ZeroMemory(@fSoldPartOutValue_nAvg, SizeOf(partout_t));

ZeroMemory(@fSoldPartOutValue_nQtyAvg, SizeOf(partout_t));

ZeroMemory(@fSoldPartOutValue_uAvg, SizeOf(partout_t));

ZeroMemory(@fSoldPartOutValue_uQtyAvg, SizeOf(partout_t));

ZeroMemory(@fAvailablePartOutValue_nAvg, SizeOf(partout_t));

ZeroMemory(@fAvailablePartOutValue_nQtyAvg, SizeOf(partout_t));

ZeroMemory(@fAvailablePartOutValue_uAvg, SizeOf(partout_t));

ZeroMemory(@fAvailablePartOutValue_uQtyAvg, SizeOf(partout_t));

fnumlooseparts := 0;

fnumsets := 0;

frealnumlooseparts := 0;

frealnumsets := 0;

flooseparts := nil;

fsets := nil;

fneedsReorganize := false;

end;

procedure TBrickInventory._growparts;

begin

if fnumlooseparts >= frealnumlooseparts then

begin

frealnumlooseparts := frealnumlooseparts 64;

ReallocMem(flooseparts, frealnumlooseparts * SizeOf(brickpool_t));

end;

end;

procedure TBrickInventory._growsets;

begin

if fnumsets >= frealnumsets then

begin

frealnumsets := frealnumsets 16;

ReallocMem(fsets, frealnumsets * SizeOf(set_t));

end;

end;

destructor TBrickInventory.Destroy;

begin

Clear;

Inherited;

end;

function TBrickInventory.LoadLooseParts(const fname: string): boolean;

var

s: TStringList;

i: integer;

spart, scolor, snum, scost: string;

np: integer;

begin

s := TStringList.Create;

s.LoadFromFile(fname);

if s.Count = 0 then

begin

s.Free;

Result := false;

exit;

end;

if (s.Strings[0] = 'Part,Color,Num') or (s.Strings[0] = 'Part,Color,Num,Cost') then

begin

for i := 1 to s.Count - 1 do

begin

splitstringex(s.Strings[i], spart, scolor, snum, scost, ',');

spart:= Trim(spart);

scolor:= Trim(scolor);

scost:= Trim(scost);

np := StrToIntDef(Trim(snum), 0);

if Pos('BL ', spart) = 1 then

spart := db.RebrickablePart(Copy(spart, 4, Length(spart) - 3))

else

spart := db.RebrickablePart(spart);

if Pos('BL', scolor) = 1 then

begin

scolor := Copy(scolor, 3, Length(scolor) - 2);

if np > 0 then

AddLoosePartFast(spart, db.BrickLinkColorToRebrickableColor(StrToIntDef(scolor, 0)), np)

else

AddLoosePart(spart, db.BrickLinkColorToRebrickableColor(StrToIntDef(scolor, 0)), np);

end

else

begin

if np > 0 then

AddLoosePartFast(spart, StrToIntDef(scolor, 0), np)

else

AddLoosePart(spart, StrToIntDef(scolor, 0), np);

end;

end;

Reorganize;

s.Free;

Result := True;

end

else

begin

s.Free;

Result := false;

end;

end;

function TBrickInventory.LoadSets(const fname: string): boolean;

var

s: TStringList;

i, j: integer;

sset, snum, sdismantaled: string;

begin

s := TStringList.Create;

s.LoadFromFile(fname);

if s.Count = 0 then

begin

s.Free;

Result := false;

exit;

end;

if s.Strings[0] <> 'Set,Num,Dismantaled' then

begin

s.Free;

Result := false;

exit;

end;

for i := 1 to s.Count - 1 do

begin

splitstringex(s.Strings[i], sset, snum, sdismantaled, ',');

sset:= Trim(sset);

snum:= Trim(snum);

sdismantaled:= Trim(sdismantaled);

for j := 0 to StrToIntDef(snum, 0) - 1 do

AddSet(sset, false);

for j := 0 to StrToIntDef(sdismantaled, 0) - 1 do

AddSet(sset, true);

end;

s.Free;

Result := True;

end;

procedure TBrickInventory.SaveLooseParts(const fname: string);

var

s: TStringList;

i: integer;

begin

s := TStringList.Create;

s.Add('Part,Color,Num');

try

for i := 0 to fnumlooseparts - 1 do

s.Add(Format('%s,%d,%d', [flooseparts[i].part, flooseparts[i].color, flooseparts[i].num]));

backupfile(fname);

s.SaveToFile(fname);

except

I_Warning('TBrickInventory.SaveLooseParts(): Can not save file %s'#13#10, [fname]);

end;

s.Free;

end;

procedure TBrickInventory.SaveLoosePartsWantedListNew(const fname: string;

const pricefactor: Double = 1.0; const wl: Integer = 0);

var

s: TStringList;

i: integer;

pci: TPieceColorInfo;

begin

s := TStringList.Create;

s.Add('<INVENTORY>');

for i := 0 to fnumlooseparts - 1 do

begin

pci := db.PieceColorInfo(flooseparts[i].part, flooseparts[i].color);

if pci <> nil then

begin

if pci.EvaluatePriceNew > 0 then

s.Add(

Format(

'<ITEM><ITEMTYPE>%s</ITEMTYPE><ITEMID>%s</ITEMID><COLOR>%d</COLOR><MAXPRICE>%2.4f</MAXPRICE><MINQTY>%d</MINQTY><NOTIFY>N</NOTIFY><WANTEDLISTID>%d</WANTEDLISTID></ITEM>',

[pci.ItemType, db.BrickLinkPart(flooseparts[i].part), db.colors(flooseparts[i].color).BrickLinkColor, pci.EvaluatePriceNew * pricefactor, flooseparts[i].num, wl]))

else

s.Add(

Format(

'<ITEM><ITEMTYPE>%s</ITEMTYPE><ITEMID>%s</ITEMID><COLOR>%d</COLOR><MINQTY>%d</MINQTY><NOTIFY>N</NOTIFY><WANTEDLISTID>%d</WANTEDLISTID></ITEM>',

[pci.ItemType, db.BrickLinkPart(flooseparts[i].part), db.colors(flooseparts[i].color).BrickLinkColor, flooseparts[i].num, wl]));

end

else

begin

s.Add(

Format(

'<ITEM><ITEMTYPE>P</ITEMTYPE><ITEMID>%s</ITEMID><COLOR>%d</COLOR><MINQTY>%d</MINQTY><NOTIFY>N</NOTIFY><WANTEDLISTID>%d</WANTEDLISTID></ITEM>',

[db.BrickLinkPart(flooseparts[i].part), db.colors(flooseparts[i].color).BrickLinkColor, flooseparts[i].num, wl]));

end;

end;

s.Add('</INVENTORY>');

try

s.SaveToFile(fname);

except

I_Warning('TBrickInventory.SaveLoosePartsWantedList(): Can not save file %s'#13#10, [fname]);

end;

s.Free;

end;

procedure TBrickInventory.SaveLoosePartsWantedListUsed(const fname: string;

const pricefactor: Double = 1.0; const wl: Integer = 0);

var

s: TStringList;

i: integer;

pci: TPieceColorInfo;

begin

s := TStringList.Create;

s.Add('<INVENTORY>');

for i := 0 to fnumlooseparts - 1 do

begin

pci := db.PieceColorInfo(flooseparts[i].part, flooseparts[i].color);

if pci <> nil then

begin

if pci.EvaluatePriceNew > 0 then

s.Add(

Format(

'<ITEM><ITEMTYPE>%s</ITEMTYPE><ITEMID>%s</ITEMID><COLOR>%d</COLOR><MAXPRICE>%2.4f</MAXPRICE><MINQTY>%d</MINQTY><NOTIFY>N</NOTIFY><WANTEDLISTID>%d</WANTEDLISTID></ITEM>',

[pci.ItemType, db.BrickLinkPart(flooseparts[i].part), db.colors(flooseparts[i].color).BrickLinkColor, pci.EvaluatePriceUsed * pricefactor, flooseparts[i].num, wl]))

else

s.Add(

Format(

'<ITEM><ITEMTYPE>%s</ITEMTYPE><ITEMID>%s</ITEMID><COLOR>%d</COLOR><MINQTY>%d</MINQTY><NOTIFY>N</NOTIFY><WANTEDLISTID>%d</WANTEDLISTID></ITEM>',

[pci.ItemType, db.BrickLinkPart(flooseparts[i].part), db.colors(flooseparts[i].color).BrickLinkColor, flooseparts[i].num, wl]));

end

else

begin

s.Add(

Format(

'<ITEM><ITEMTYPE>P</ITEMTYPE><ITEMID>%s</ITEMID><COLOR>%d</COLOR><MINQTY>%d</MINQTY><NOTIFY>N</NOTIFY><WANTEDLISTID>%d</WANTEDLISTID></ITEM>',

[db.BrickLinkPart(flooseparts[i].part), db.colors(flooseparts[i].color).BrickLinkColor, flooseparts[i].num, wl]));

end;

end;

s.Add('</INVENTORY>');

try

s.SaveToFile(fname);

except

I_Warning('TBrickInventory.SaveLoosePartsWantedList(): Can not save file %s'#13#10, [fname]);

end;

s.Free;

end;

procedure TBrickInventory.SavePartsInventoryPriceguide(const fname: string);

var

s: TStringList;

i: integer;

pci: TPieceColorInfo;

begin

s := TStringList.Create;

s.Add('Part;Color;Num;pg_nTimesSold;pg_nTotalQty;pg_nMinPrice;pg_nAvgPrice;'

'pg_nQtyAvgPrice;pg_nMaxPrice;pg_uTimesSold;pg_uTotalQty;pg_uMinPrice;'

'pg_uAvgPrice;pg_uQtyAvgPrice;pg_uMaxPrice;av_nTotalLots;av_nTotalQty;'

'av_nMinPrice;av_nAvgPrice;av_nQtyAvgPrice;av_nMaxPrice;av_uTotalLots;'

'av_uTotalQty;av_uMinPrice;av_uAvgPrice;av_uQtyAvgPrice;av_uMaxPrice;'

'EvaluatePriceNew;EvaluatePriceUsed');

for i := 0 to fnumlooseparts - 1 do

begin

pci := db.PieceColorInfo(flooseparts[i].part, flooseparts[i].color);

if pci <> nil then

begin

if not pci.hasloaded then

pci.Load;

s.Add(Format('%s;%d;%d;%d;%d;%2.5f;%2.5f;%2.5f;%2.5f;%d;%d;%2.5f;%2.5f;%2.5f;%2.5f'

';%d;%d;%2.5f;%2.5f;%2.5f;%2.5f;%d;%d;%2.5f;%2.5f;%2.5f;%2.5f;%2.5f;%2.5f', [

flooseparts[i].part,

flooseparts[i].color,

flooseparts[i].num,

pci.priceguide.nTimesSold,

pci.priceguide.nTotalQty,

pci.priceguide.nMinPrice,

pci.priceguide.nAvgPrice,

pci.priceguide.nQtyAvgPrice,

pci.priceguide.nMaxPrice,

pci.priceguide.uTimesSold,

pci.priceguide.uTotalQty,

pci.priceguide.uMinPrice,

pci.priceguide.uAvgPrice,

pci.priceguide.uQtyAvgPrice,

pci.priceguide.uMaxPrice,

pci.availability.nTotalLots,

pci.availability.nTotalQty,

pci.availability.nMinPrice,

pci.availability.nAvgPrice,

pci.availability.nQtyAvgPrice,

pci.availability.nMaxPrice,

pci.availability.uTotalLots,

pci.availability.uTotalQty,

pci.availability.uMinPrice,

pci.availability.uAvgPrice,

pci.availability.uQtyAvgPrice,

pci.availability.uMaxPrice,

pci.EvaluatePriceNew,

pci.EvaluatePriceUsed

]));

end

else

s.Add(Format('%s,%d,%d', [flooseparts[i].part, flooseparts[i].color, flooseparts[i].num]));

end;

try

backupfile(fname);

s.SaveToFile(fname);

except

I_Warning('TBrickInventory.SavePartsInventoryPriceguide(): Can not save file %s'#13#10, [fname]);

end;

s.Free;

end;

procedure TBrickInventory.SaveSets(const fname: string);

var

s: TStringList;

i: integer;

begin

s := TStringList.Create;

s.Add('Set,Num,Dismantaled');

for i := 0 to fnumsets - 1 do

s.Add(Format('%s,%d,%d', [fsets[i].setid, fsets[i].num, fsets[i].dismantaled]));

try

backupfile(fname);

s.SaveToFile(fname);

except

I_Warning('TBrickInventory.SaveSets(): Can not save file %s'#13#10, [fname]);

end;

s.Free;

end;

procedure TBrickInventory.Reorganize;

var

nparts: brickpool_pa;

nnum: integer;

i: integer;

pci: TPieceColorInfo;

begin

if not fneedsReorganize then

exit;

if fnumlooseparts = 0 then

exit;

nnum := fnumlooseparts;

GetMem(nparts, nnum * SizeOf(brickpool_t));

for i := 0 to nnum - 1 do

nparts[i] := flooseparts[i];

FreeMem(flooseparts);

flooseparts := nil;

fnumlooseparts := 0;

frealnumlooseparts := 0;

for i := 0 to nnum - 1 do

begin

AddLoosePart(nparts[i].part, nparts[i].color, nparts[i].num);

pci := db.PieceColorInfo(nparts[i].part, nparts[i].color);

if pci = nil then

begin

pci := TPieceColorInfo.Create(nparts[i].part, nparts[i].color);

if db.Colors(nparts[i].color).knownpieces = nil then

db.Colors(nparts[i].color).knownpieces := THashStringList.Create;

db.Colors(nparts[i].color).knownpieces.AddObject(nparts[i].part, pci);

end;

end;

FreeMem(nparts, nnum * SizeOf(brickpool_t));

fneedsReorganize := false;

end;

procedure TBrickInventory.Clear;

begin

if flooseparts <> nil then

begin

FreeMem(flooseparts);

flooseparts := nil;

end;

fnumlooseparts := 0;

frealnumlooseparts := 0;

if fsets <> nil then

begin

FreeMem(fsets);

fsets := nil;

end;

fnumsets := 0;

frealnumsets := 0;

end;

procedure TBrickInventory.MergeWith(const inv: TBrickInventory);

var

i, j: integer;

begin

if inv = nil then

exit;

for i := 0 to inv.fnumsets - 1 do

begin

for j := 0 to inv.fsets[i].num - 1 do

AddSet(inv.fsets[i].setid, false);

for j := 0 to inv.fsets[i].dismantaled - 1 do

AddSet(inv.fsets[i].setid, true);

end;

for i := 0 to inv.fnumlooseparts - 1 do

AddLoosePart(inv.flooseparts[i].part, inv.flooseparts[i].color, inv.flooseparts[i].num);

end;

function TBrickInventory.Clone: TBrickInventory;

begin

result := TBrickInventory.Create;

result.MergeWith(self);

end;

function TBrickInventory.numlotsbycolor(const col: integer): integer;

var

i: integer;

begin

if col = -1 then

begin

result := fnumlooseparts;

exit;

end;

result := 0;

for i := 0 to fnumlooseparts - 1 do

if flooseparts[i].color = col then

inc(result);

end;

function TBrickInventory.numlotsbypart(const pt: string): integer;

var

i: integer;

begin

if pt = '' then

begin

result := fnumlooseparts;

exit;

end;

result := 0;

for i := 0 to fnumlooseparts - 1 do

if flooseparts[i].part = pt then

inc(result);

end;

function TBrickInventory.numlotsbycatcolor(const col: integer; const cat: integer): integer;

var

i: integer;

begin

if cat = -1 then

begin

result := totallooseparts;

exit;

end;

result := 0;

for i := 0 to fnumlooseparts - 1 do

if flooseparts[i].color = col then

if db.PieceInfo(flooseparts[i].part).category = cat then

inc(result);

end;

function TBrickInventory.numlotsbycategory(const cat: integer): integer;

var

i: integer;

begin

if cat = -1 then

begin

result := totallooseparts;

exit;

end;

result := 0;

for i := 0 to fnumlooseparts - 1 do

if db.PieceInfo(flooseparts[i].part).category = cat then

inc(result);

end;