unit U_ImportDBF; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Mask, RzEdit, DB, DBTables, RzButton, ComCtrls, U_SCSComponent, U_Main, U_BaseCommon, U_BaseConstants, IB_Services, siComp, siLngLnk; const // razdel index rlNone = 0; rlRoot = 1; rlRazdel = 2; rlPodrazdel = 3; // FieldNames fnARTPROIZV = 'ARTPROIZV'; fnARTDISTR = 'ARTDISTR'; fnCOMPTYPE = 'COMPTYPE'; fnNETTYPE = 'NETTYPE'; fnPRODUCER = 'PRODUCER'; fnNAME = 'NAME'; fnPRICE = 'PRICE'; fnPRICEOPT = 'PRICEOPT'; fnRAZDEL = 'RAZDEL'; fnPODRAZDEL = 'PODRAZDEL'; type TF_ImportDBF = class(TForm) Table: TTable; Label1: TLabel; edFileName: TRzEdit; btChoiceDBF: TRzButton; OpenDialog: TOpenDialog; btGrubCompons: TRzButton; btClose: TRzBitBtn; lng_Forms: TsiLangLinked; cbLoadFromTemplates: TCheckBox; procedure btChoiceDBFClick(Sender: TObject); procedure btGrubComponsClick(Sender: TObject); private FNBNode: TTreeNode; FGrubClickCount: Integer; function AddCatalog(AParentNode: TTreeNode; ANewCatalogName: String): TSCSCatalog; public procedure Execute(ANBNode: TTreeNode); end; var F_ImportDBF: TF_ImportDBF; implementation Uses U_Animate, U_ProtectionCommon; {$R *.dfm} procedure TF_ImportDBF.btChoiceDBFClick(Sender: TObject); begin if OpenDialog.Execute then begin edFileName.Text := OpenDialog.FileName; end; end; function TF_ImportDBF.AddCatalog(AParentNode: TTreeNode; ANewCatalogName: String): TSCSCatalog; var Node: TTreeNode; begin Result := nil; Node := F_NormBase.MakeDir(cfBase, AParentNode, ANewCatalogName, itDir, nil); Result := TSCSCatalog.Create(F_NormBase); Result.LoadCatalogByID(PObjectData(Node.Data).ObjectID); Result.TreeViewNode := Node; end; procedure TF_ImportDBF.btGrubComponsClick(Sender: TObject); var RootCatalog: TSCSCatalog; RootNode: TTreeNode; WorkCatalog: TSCSCatalog; CatalogNode: TTreeNode; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; RazdelLevel: Integer; NewRazdelLevel: Integer; PriceType: Char; strPrice: String; DirName: String; CurrIDComponentType: Integer; CurrIDNetType: Integer; CurrIDProducer: Integer; RecordCount: Integer; RecNo: Integer; SuppliesKind: TSuppliesKind; ptrSuppliesKind: PSuppliesKind; ComponentTemplates: TSCSComponents; ComponentTemplate: TSCSComponent; ComponDataFlags: TCompDataFlags; LastNppPort: Integer; StepIndex: Integer; AllSuppliesKinds: TList; Stream: TMemoryStream; StreamSize: Integer; begin try if FileExists(edFileName.Text) then begin Table.Active := false; Table.DatabaseName := ExtractFileDir(edFileName.Text); Table.TableName := ExtractFileName(edFileName.Text); Table.Active := true; if Table.Active then begin RazdelLevel := rlRoot; WorkCatalog := nil; ComponDataFlags := [cdCableCanalConnectors, //cdConections, cdCrossConnections, cdProperties, cdInterfaces, cdComponentType, cdNorms, cdResources]; ComponentTemplates := TSCSComponents.Create(true); AllSuppliesKinds := nil; //RootNode := F_NormBase.MakeDir(cfBase, FNBNode, Table.TableName, itDir, nil); //RootCatalog := TSCSCatalog.Create(F_NormBase); //RootCatalog.LoadCatalogByID(PObjectData(RootNode.Data).ObjectID); //RootCatalog.TreeViewNode := RootNode; //WorkCatalog := RootCatalog; WorkCatalog := AddCatalog(FNBNode, Table.TableName); CurrIDComponentType := 0; //31; // Null CurrIDNetType := 0; CurrIDProducer := 0; RecordCount := Table.RecordCount; RecNo := 0; Stream := TMemoryStream.Create; F_NormBase.F_Animate.GMaxProgressPos := RecordCount; F_NormBase.F_Animate.StartAnimate(cImportDBF_Msg1, aviCopyFiles, aiProgressBar); try Table.First; while Not Table.Eof do begin Inc(RecNo); //*** Тип компонент в папке if (Table.FieldDefs.IndexOf(fnCOMPTYPE) <> -1) and (Table.FieldByName(fnCOMPTYPE).AsString <> '') then CurrIDComponentType := StrToInt(Table.FieldByName(fnCOMPTYPE).AsString); if (Table.FieldDefs.IndexOf(fnNETTYPE) <> -1) and (Table.FieldByName(fnNETTYPE).AsString <> '') then CurrIDNetType := StrToInt(Table.FieldByName(fnNETTYPE).AsString); if (Table.FieldDefs.IndexOf(fnPRODUCER) <> -1) and (Table.FieldByName(fnPRODUCER).AsString <> '') then CurrIDProducer := StrToInt(Table.FieldByName(fnPRODUCER).AsString); //*** Создаем под папку if (Table.FieldByName(fnRAZDEL).AsString <> '') or (Table.FieldByName(fnPODRAZDEL).AsString <> '') then begin NewRazdelLevel := rlNone; DirName := ''; //*** Определяем уровень новой папки if Table.FieldByName(fnRAZDEL).AsString <> '' then begin // Если раздел, то выходим в Root if RazdelLevel = rlRazdel then WorkCatalog := TSCSCatalog(WorkCatalog.Parent) else // Если подраздел, то выходим в Root if RazdelLevel = rlPodRazdel then WorkCatalog := TSCSCatalog(WorkCatalog.Parent.Parent); NewRazdelLevel := rlRazdel; DirName := Table.FieldByName(fnRAZDEL).AsString; end else if Table.FieldByName(fnPODRAZDEL).AsString <> '' then begin NewRazdelLevel := rlPodRazdel; if RazdelLevel = rlRazdel then NewRazdelLevel := rlPodRazdel else if RazdelLevel = rlPodRazdel then WorkCatalog := TSCSCatalog(WorkCatalog.Parent) else //*** На всякий-який if RazdelLevel = rlRoot then NewRazdelLevel := rlRazdel; DirName := Table.FieldByName(fnPODRAZDEL).AsString; end; if NewRazdelLevel <> rlNone then begin SCSCatalog := AddCatalog(WorkCatalog.TreeViewNode, DirName); WorkCatalog.AddChildCatalogToList(SCSCatalog); WorkCatalog := SCSCatalog; RazdelLevel := NewRazdelLevel; end; //*** Тип компонент в папке //if (Table.FieldDefs.IndexOf(fnIzm) <> -1) and (Table.FieldByName(fnCOMPTYPE).AsString <> '') then // CurrIDComponentType := StrToInt(Table.FieldByName(fnCOMPTYPE).AsString); end else //*** Создаем компонент if (WorkCatalog <> nil) and (Table.FieldByName(fnName).AsString <> '') then begin //*** Определить вид поставки ZeroMemory(@SuppliesKind, SizeOf(TSuppliesKind)); try if Table.FieldDefs.IndexOf(fnIzm) <> -1 then SuppliesKind.Izm := Table.FieldByName(fnIzm).AsString; if Table.FieldDefs.IndexOf(fnUnitKolvo) <> -1 then if Table.FieldByName(fnUnitKolvo).AsString <> '' then SuppliesKind.UnitKolvo := StrToFloatU(CorrectStrToFloat(Table.FieldByName(fnUnitKolvo).AsString)); except on E: Exception do AddExceptionToLogEx('TF_ImportDBF.btGrubComponsClick', E.Message); end; ptrSuppliesKind := nil; if SuppliesKind.UnitKolvo > 0 then begin if AllSuppliesKinds = nil then AllSuppliesKinds := F_NormBase.DM.GetAllSuppliesKinds; ptrSuppliesKind := GetSuppliesKindByIzmAndKolvo('', SuppliesKind.Izm, SuppliesKind.UnitKolvo, AllSuppliesKinds); //*** Поставка не найдена, создать ее if ptrSuppliesKind = nil then begin GetZeroMem(ptrSuppliesKind, SizeOf(TSuppliesKind)); ptrSuppliesKind.Izm := SuppliesKind.Izm; ptrSuppliesKind.UnitKolvo := SuppliesKind.UnitKolvo; ptrSuppliesKind.Name := CPacking+' ' +FloatToStr(RoundCP(ptrSuppliesKind.UnitKolvo))+' '+SuppliesKind.Izm; ptrSuppliesKind.NameTradUOM := ptrSuppliesKind.Name; ptrSuppliesKind.Izm := ptrSuppliesKind.IzmTradUOM; ptrSuppliesKind.UnitKolvo := ptrSuppliesKind.UnitKolvoTradUOM; F_NormBase.DM.InsertSuppliesKindToTopDirType(ptrSuppliesKind); //F_NormBase.DM.SaveSuppliesKind(meMake, ptrSuppliesKind); //ptrSuppliesKind.ID := GenIDFromTable(F_NormBase.DM.Query_Select, gnSuppliesKindsID, 0); AllSuppliesKinds.Add(ptrSuppliesKind); end; if ptrSuppliesKind <> nil then SuppliesKind := ptrSuppliesKind^; end; SCSComponent := TSCSComponent.Create(F_NormBase); SCSComponent.ID_ComponentType := CurrIDComponentType; SCSComponent.IDNetType := CurrIDNetType; SCSComponent.ID_Producer := CurrIDProducer; SCSComponent.LoadComponentType; if cbLoadFromTemplates.Checked and (SCSComponent.ComponentType.IDComponTemplate > 0) then begin ComponentTemplate := ComponentTemplates.GetComponenByID(SCSComponent.ComponentType.IDComponTemplate); if ComponentTemplate = nil then begin ComponentTemplate := TSCSComponent.Create(F_NormBase); ComponentTemplates.Add(ComponentTemplate); ComponentTemplate.LoadComponentByID(SCSComponent.ComponentType.IDComponTemplate); ComponentTemplate.LoadComponentData(ComponDataFlags); end; if ComponentTemplate <> nil then begin SCSComponent.Assign(ComponentTemplate, true, true); LastNppPort := 0; StepIndex := 0; SCSComponent.DefineIDsBeforeSaveAsNew{(nil, nil, LastNppPort, StepIndex)}; end; end else begin SCSComponent.LoadPropertyesFromComponentType; if SCSComponent.ComponentType.IDDesignIcon <> 0 then SCSComponent.IDObjectIcon := SCSComponent.ComponentType.IDDesignIcon; end; SCSComponent.Cypher := F_NormBase.DM.GenComponentNewCypher; //GenNewComponentCypher; SCSComponent.Name := Table.FieldByName(fnName).AsString; if Table.FieldDefs.IndexOf(fnARTDISTR) <> -1 then SCSComponent.ArticulDistributor := Table.FieldByName(fnARTDISTR).AsString; if Table.FieldDefs.IndexOf(fnARTPROIZV) <> -1 then SCSComponent.ArticulProducer := Table.FieldByName(fnARTPROIZV).AsString; if SCSComponent.ArticulProducer = '' then SCSComponent.ArticulProducer := SCSComponent.ArticulDistributor; if SCSComponent.ArticulDistributor = '' then SCSComponent.ArticulDistributor := SCSComponent.ArticulProducer; strPrice := Table.FieldByName(fnPRICE).AsString; if strPrice <> '' then begin try if (strPrice[1] <> '€') and (strPrice[1] <> '$') then PriceType := '$' else begin PriceType := strPrice[1]; Delete(strPrice, 1, 1); end; strPrice := CorrectStrToFloat(strPrice); SCSComponent.Price := RoundCP(StrToFloatU(strPrice)); SCSComponent.Price_Calc := RoundCP(SCSComponent.Price); except end; end; SCSComponent.IsLine := SCSComponent.ComponentType.IsLine; //*** Вид поставки if SuppliesKind.Izm <> '' then SCSComponent.Izm := SuppliesKind.Izm; if ptrSuppliesKind <> nil then begin SCSComponent.IDSuppliesKind := ptrSuppliesKind.ID; SCSComponent.PriceSupply := RoundCP(SCSComponent.Price * ptrSuppliesKind.UnitKolvo); end; // Примечание if Table.FieldDefs.IndexOf(fnNotice) <> -1 then SCSComponent.Notice := Table.FieldByName(fnNotice).AsString; //*** Описание if Table.FieldDefs.IndexOf(fnDesc) <> -1 then begin Stream.Clear; Stream.Position := 0; TBlobField(Table.FieldByName(fnDesc)).SaveToStream(Stream); StreamSize := Stream.Size; if StreamSize > 0 then begin CopyStream(SCSComponent.Description, Stream); end; end; //SCSComponent.LoadPropertyesFromComponentType; //if SCSComponent.ComponentType.IDDesignIcon <> 0 then // SCSComponent.IDSymbol := SCSComponent.ComponentType.IDDesignIcon; //*** Сохраняем в базу try SCSComponent.GuidNB := CreateGUID; SCSComponent.SaveComponentAsNew(true, false); F_NormBase.AppendToCatalRel(WorkCatalog.ID, SCSComponent.ID); SCSComponent.TreeViewNode := F_NormBase.MakeNodeForNewComponent(WorkCatalog.TreeViewNode, SCSComponent); WorkCatalog.AddComponentToList(SCSComponent); except end; end; F_NormBase.F_Animate.SetProgressPos(RecNo + 1); Table.Next; end; finally F_NormBase.F_Animate.StopAnimate; Table.Active := false; ComponentTemplates.Free; if AllSuppliesKinds <> nil then FreeList(AllSuppliesKinds); FreeAndNil(Stream); end; end else ShowMessage(cImportDBF_Msg2+' '+Table.TableName); end else ShowMessage(cImportDBF_Msg3+' '+edFileName.Text); except on E: Exception do AddExceptionToLogEx('TF_ImportDBF.btGrubComponsClick', E.Message); end; end; procedure TF_ImportDBF.Execute(ANBNode: TTreeNode); begin FNBNode := ANBNode; FGrubClickCount := 0; {$if Defined(ES_GRAPH_SC)} OpenDialog.InitialDir := ExeDir; {$else} OpenDialog.InitialDir := ExtractFileDir(Application.ExeName); {$ifend} ShowModal; if FGrubClickCount > 0 then begin //*** Переопределить виды поставок НБ F_NormBase.GSCSBase.NBSpravochnik.LoadSuppliesKinds; end; end; end.