"Robert K" wrote:


"Robert K" <ngsemail2005withoutthis@yahoo.com.ar> wrote in message
news:94108052-63EE-4FC7-9F6B-A93AA305B835@news.elevatesoft.com...
>
> <Stephen Barker> wrote in message
> news:7FB163F7-9A1B-4A9C-873A-D360BF502466@news.elevatesoft.com...
>> My table is getting recreated each time. A second function that reads the
>> table is freezing when it hits the corruption.
>> I have tried making a small test application and inserting random data
>> but I can't get the corruption to appear in this. I'll continue trying to
>> isolate a test case. Is it still worth sending one of the corrupt tables?
>> Steve
>>
>
> tell us a bit about this second function. or anybody else that might be
> accessing the table. look for the non-obvious in your aplication. is some
> thread mucking with the table? somebody starting and ending transactions
> while the table is being updated?
>

Some logic changing the index?

r

Hi Robert,

The second function doesn't cause the problem - if I comment it out the first function which creates the file still causes the corruption, given I let it run through a sufficient number of records. The tables are not opened by anyone else. No transactions involved either.

Here's the actual code - firstly the table creation code, then the code that populates it. All supporting functions for which I haven't included source are just are looking up other tables and arrays as part of the pricing calculations.

thanks,
Steve

procedure Tdm.CreateExportTable(const branch: string);
begin
 with tbExport do begin
   TableName := 'Invm_'+branch;
   if Exists then DeleteTable;
   FieldDefs.Clear;
   with FieldDefs.AddFieldDef do begin
     Name := 'Sku';
     DataType := ftString;
     Size := 8;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Descr';
     DataType := ftString;
     Size := 40;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'SuppCode';
     DataType := ftString;
     Size := 5;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Grade';
     DataType := ftString;
     Size := 3;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Dept';
     DataType := ftString;
     Size := 2;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Group';
     DataType := ftString;
     Size := 3;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Class';
     DataType := ftString;
     Size := 2;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'SubClass';
     DataType := ftString;
     Size := 2;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Cost';
     DataType := ftCurrency;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Unit';
     DataType := ftString;
     Size := 4;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Price';
     DataType := ftCurrency;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Price1';
     DataType := ftCurrency;
   end;
   with FieldDefs.AddFieldDef do begin
     //Name := 'PriceT';
     Name := 'Price2';
     DataType := ftCurrency;
   end;
   with FieldDefs.AddFieldDef do begin
     //Name := 'PriceP';
     Name := 'Price3';
     DataType := ftCurrency;
   end;
   with FieldDefs.AddFieldDef do begin
     //Name := 'PricePS';
     Name := 'Price4';
     DataType := ftCurrency;
   end;
   with FieldDefs.AddFieldDef do begin
     //Name := 'PricePX';
     Name := 'Price5';
     DataType := ftCurrency;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Markup1';
     DataType := ftFloat;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Markup2';
     DataType := ftFloat;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Markup3';
     DataType := ftFloat;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Markup4';
     DataType := ftFloat;
   end;
   with FieldDefs.AddFieldDef do begin
     Name := 'Markup5';
     DataType := ftFloat;
   end;

   IndexDefs.Clear;
   with IndexDefs.AddIndexDef do begin
     Name := '';
     Fields := 'Sku';
     Options := [ixPrimary];
   end;
   CreateTable;
 end;
end;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
procedure Tdm.ExportBranch(const Branch: string;
                          slGrades, slDepts : TStringList;
                          var aMatrix, aGroup: TstringArray;
                              aPrice: TdoubleArray;
                          var tbxSKU, tbxSupplier : TDBISAMTable);
const
 testlimit = 40000;
var
 sku : string;
 nIndex, i, counter : integer;
 strDept, strGroup, strClass, strSubClass, strDiscount : string;
 nPrice, tempprice : double;
 pdept, pGroup : string;
 nMarkup : double;
 spfound : boolean;
 si, newfile : string;
begin
 try
   tbExport.Open;
   qStock.Close;
   if not qStock.Prepared then
     qStock.Prepare;
   qStock.Params[0].asString := branch;
   qStock.Open;
   qStock.First;  // distinct sku's
   frmMain.lblProgress.visible := true;
   counter := 0;                                           
   while not qStock.eof do begin
     frmMain.lblProgress.Caption := IntToStr(qStock.RecNo)+'/'+IntToStr(qStock.RecordCount);
     frmMain.lblProgress.Update;
     Application.ProcessMessages;
     inc(counter);
// todo: remove before release
if counter > testlimit then break;
     sku := qStock.FieldByName('sku').asString;
     // see if grade and dept are ok
     if trim(qStock.FieldByName('grade').asString) = '' then begin
       qStock.next;
       continue;
     end;
     if (slGrades.IndexOf(qStock.FieldByName('grade').asString) >= 0) then begin
       qStock.next;
       continue;
     end;
     strDept := copy(qStock.FieldByName('dept').asString,length(qStock.FieldByName('dept').asString)-1,2);
     strGroup := qStock.FieldByName('dispgrp').asString;
     strClass := qStock.FieldByName('class').asString;  // 2 char
     strSubClass := qStock.FieldByName('subclass').asString;  // 2 char

     if not incprod(strDept, strGroup, strClass, strSubClass, slDepts) then begin
       qStock.next;
       continue;
     end;

     // find record in b2be for this sku and branch if exists

     if tbStock.locate('ledger;sku', VarArrayOf([branch,sku]), []) then
       // use this record - branch price overrides national price
     else if tbStock.locate('ledger;sku', VarArrayOf(['NAT',sku]), []) then
       // use national price (null ledger code)
     else begin
       raise exception.create('National price not found for SKU: '+sku);
     end;

     // other blacklist filters
     if tbxSKU.FindKey([sku]) then begin
       qStock.next;
       continue;
     end;
     if tbxSupplier.FindKey([tbStock.FieldByName('suppcode').asString]) then begin
       qStock.next;
       continue;
     end;

     with tbExport do begin
       Append;
       FieldByName('sku').asString := sku;
       FieldByName('descr').asString := tbStock.FieldByName('descr').asString;
       FieldByName('suppcode').asString := tbStock.FieldByName('suppcode').asString;
       FieldByName('grade').asString := tbStock.FieldByName('grade').asString;
       FieldByName('dept').asString := strDept;
       FieldByName('group').asString := strGroup;
       FieldByName('class').asString := strClass;  // 2 char
       FieldByName('subclass').asString := strSubClass;   // 2 char
       FieldByName('unit').asString := tbStock.FieldByName('unitom').asString;
       FieldByName('cost').asFloat := StrToFloatDef(tbStock.FieldByName('cost').asString,0);
       // start with default pricing from b2be
       FieldByName('price').asFloat := StrToFloatDef(tbStock.FieldByName('price').asString,0);

       // look for special customer group pricing, by dept/grp/class/subclass or sku
       for nIndex := 0 to high(aMatrix) do begin
         strDiscount := aMatrix[nIndex];
         strGroup := aGroup[nIndex];
         if pos('V', FieldByName('grade').asString) > 0 then begin
           nPrice := FieldByName('price').asFloat; // retail
         end else begin
           case strDiscount[1] of
             '1': nPrice := StrToFloatDef(tbStock.FieldByName('price').asString,0);   // retail
             '2': nPrice := StrToFloatDef(tbStock.FieldByName('pricet').asString,0);  // trade
             '3': nPrice := StrToFloatDef(tbStock.FieldByName('pricep').asString,0);  // preferred
             '4': nPrice := StrToFloatDef(tbStock.FieldByName('priceps').asString,0);  // ps
             '5': nPrice := StrToFloatDef(tbStock.FieldByName('pricepx').asString,0);  // px
           else
             nPrice := StrToFloatDef(tbStock.FieldByName('price').asString,0);
           end;
           // lookup special pricing based on cust_group if specified
           if strGroup <> '' then begin
             spfound := tbCust_Prc.Locate('Ledger;Cust_Group;SKU',VarArrayOf([Branch,strGroup,Sku]), []);
             if not spfound then
               // no records for this branch so try for NATional prices - 20090501
               spfound := tbCust_Prc.Locate('Ledger;Cust_Group;SKU',VarArrayOf(['NAT',strGroup,Sku]), []);
             // take any lower price
             if spfound then begin
               tempprice := StrToFloatDef(tbCust_Prc.FieldByName('Price').asString,maxint);
               if (tempprice < nPrice) then
                 nPrice := tempprice;
             end;
           end;
         end;
         aPrice[nIndex] := nPrice;
       end;

       for nIndex := 1 to high(aPrice) do begin
         si := IntToStr(nIndex);
         FieldByName('Price'+si).asFloat := aPrice[nIndex];
         try
           nMarkup := ((aPrice[nIndex] - FieldByName('cost').asFloat) / FieldByName('cost').asFloat) * 100;
         except
           nMarkup := 0;
         end;
         FieldByName('Markup'+si).asFloat := nMarkup;
       end;

       //**********************************************************************
       try
         Post;
       except
         // added 20081126 to ignore very occasional dup keys
         on E: Exception do begin
           if E is EDBISAMEngineError then begin
             if EDBISAMEngineError(E).ErrorCode = 9729 then begin
               frmMain.memo1.lines.add('**Duplicate key: SKU='+sku);
             end else begin
               raise;
             end;
           end else begin
             raise;
           end;
           Cancel;
         end;
       end;
     end;
     qStock.next;
   end;
 finally
   if frmMain.MultiStore then begin
     // new method 20110624 - just create individual branch files with Retail pricing and filename suffix to distinguish them from the trade price files
     newfile := tbExport.TableName+'_Retail';
     tbExport.CopyTable(tbExport.Database.Directory, newfile);
     // change to retail pricing
     DBExport.Execute('update '+newfile+' set cost=price,price1=price,price2=price,price3=price,price4=price,price5=price,markup1=0,markup2=0,markup3=0,markup4=0,markup5=0');
   end;
   tbExport.Close;
   frmMain.lblProgress.visible := false;
   Application.ProcessMessages;
 end;
end;

Hi all,

Thanks for the help. I have tried the flush buffers thing as well as opening and closing the table all to no avail.

However I have been able to isolate the problem down to a very small test case and posted it to the binaries forum.

Steve

Stephen,

<< Since upgrading to 4.30b5 (and admittedly making a few changes as well)
it ends up with a corrupted index on the newly created export table, but
doesn't report any errors during this stage. >>

If you're performing the import on an exclusively-opened table, then this
incident report is the same issue:

http://www.elevatesoft.com/incident?action=viewrep&category=dbisam&release=4.30&incident=3461

Build 6, released today, will fix the issue for you.

--
Tim Young
Elevate Software
www.elevatesoft.com