procedure TfrmFileMngm.FormCreate(Sender: TObject); begin sgCars.Cells[0,0] := 'Марка'; sgCars.Cells[1,0] := 'V'; sgCars.Cells[2,0] := 'S'; sgErr.Cells[0,0] := 'Строка'; sgErr.Cells[1,0] := 'Ошибка'; Cars := TCarsMngm.Create; end; procedure TfrmFileMngm.btnCleanClick(Sender: TObject); begin lblErr.Visible := false; sgErr.Visible := false; btnClean.Visible := false; end;

procedure TfrmFileMngm.btnConvClick(Sender: TObject); begin if odCars.Execute then if not Cars.Convert(odCars.FileName, sgErr) then begin lblErr.Visible := true; sgErr.Visible := true; btnClean.Visible := true; end; procedure TfrmFileMngm.btnLoadClick(Sender: TObject); begin if odCars.Execute then Cars.Load(odCars.FileName, sgCars); end;

type TCar = record Mark : string[25]; V : single; S : integer; end; TCars = array of TCar; TCarsMngm = class fCarsTxt : text; bCarsTxt : string; fCars : file of TCar; bCars : TCar; Cars : TCars; function ConvertRec : integer; function Convert (_fIn : string; var _Err : TStringGrid) : boolean; procedure Load(_fIn : string; var _Cars : TStringGrid); end;

function TCarsMngm.Convert(_fIn : string; var _Err : TStringGrid) : boolean; var Cnv : integer; Res : boolean; S:string; begin Cnv := 0; AssignFile(fCarsTxt, _fIn); reset(fCarsTxt); S:=copy(_fIn, 1, length(_fIn) - 7) + 'dat'; AssignFile(fCars, S); rewrite(fCars); Res := true; while not eof(fCarsTxt) do begin readln(fCarsTxt, bCarsTxt); Cnv := ConvertRec; Res := Res and (Cnv = 0);

case Cnv of 0 : write(fCars, bCars); 1 : begin _Err.Cells[ 0, _Err.RowCount ] := bCarsTxt; _Err.Cells[ 1, _Err.RowCount ] := 'Ошибка V'; _Err.RowCount := _Err.RowCount +1; end; 2 : begin _Err.Cells[ 0, _Err.RowCount ] := bCarsTxt; _Err.Cells[ 1, _Err.RowCount ] := 'Ошибка S'; _Err.RowCount := _Err.RowCount +1; end; 3 : begin _Err.Cells[ 0, _Err.RowCount ] := bCarsTxt; _Err.Cells[ 1, _Err.RowCount ] := Ошибка формата'; _Err.RowCount := _Err.RowCount +1; end; end; {case} end; {while} close(fCars); close(fCarsTxt); Convert := Res; end;

function TCarsMngm.ConvertRec : integer; var tmp : string; begin tmp := bCarsTxt; if Pos('\', tmp) > 0 then begin bCars.Mark := copy(tmp, 1, Pos('\', tmp) - 1); delete(tmp, 1, Pos('\', tmp)); if Pos('\', tmp) > 0 then begin if TryStrToFloat(copy(tmp, 1, Pos('\', tmp) - 1), bCars.V) then begin delete(tmp, 1, Pos('\', tmp)); if TryStrToInt(tmp, bCars.S) then ConvertRec := 0 else ConvertRec := 2; end else ConvertRec := 1; end else ConvertRec := 3; end else ConvertRec := 3; end;

procedure TCarsMngm.Load(_fIn : string; var _Cars: TStringGrid); var i : integer; begin AssignFile(fCars, _fIn); reset(fCars); _Cars.RowCount := FileSize(fCars) + 1; i:=0; while not eof(fCars) do begin read(fCars, bCars); i := i+1; _Cars.Cells[0,i] := bCars.Mark; _Cars.Cells[1,i] := FloatToStr(bCars.V); _Cars.Cells[2,i] := IntToStr(bCars.S); end; close(fCars); end;

type TProductComposition=record Product, { изделие-узел} Element : string[25]; { узел-деталь } Quantity : integer; { количество } end; TCorrProductComposition=class fProductComposition:file of TProductComposition; bProductComposition:TProductComposition; fProof:file of TProductComposition; bProof:TProductComposition; fCorr:file of TProductComposition; bCorr:TProductComposition; procedure ConvProdComp; procedure ConvProof; procedure Correct; procedure ShowCorr(var _Res:TStringGrid;_f:integer); function Compare:integer; end;

function TCorrProductComposition.Compare: integer; begin if bProductComposition.Product < bProof.Product then Compare := 0 else if bProductComposition.Product = bProof.Product then if bProductComposition.Element < bProof.Element then Compare := 0 else if bProductComposition.Element = bProof.Element then Compare := 1 else Compare := 2 else Compare :=2 ; end;

function TMerge.Compare(_Scoop:boolean): integer; var KeyBucket, KeyFile: shortstring; begin with Bucket do KeyBucket:=Format('%2d%100s%2d',[Grade,Theme,ComplexityLevel]); if _Scoop then with bStudents do KeyFile:=Format('%2d%100s%2d',[Grade,Theme,ComplexityLevel]) else with bProblemPool do KeyFile:=Format('%2d%100s%2d',[Grade,Theme,Problem.ComplexityLevel]); if KeyBucket < KeyFile then Compare:=0 else if KeyBucket = KeyFile then Compare:=1 else Compare:=2; end;

TfrmFileMngm = class(TForm) odCars: TOpenDialog; sgCars: TStringGrid; sgErr: TStringGrid; lblCars: TLabel; lblErr: TLabel; btnConv: TButton; btnClean: TButton; sdCars: TSaveDialog; btnLoad: TButton; edtSI: TLabeledEdit; lblRes: TLabel; btnSearch: TButton; btnCreateH: TButton; procedure btnSearchClick(Sender: TObject); procedure btnCreateHClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btnConvClick(Sender: TObject); procedure btnCleanClick(Sender: TObject); procedure btnLoadClick(Sender: TObject); end;

function TCarsMngm.Hash(_S:string):integer; var tmp, e, i: integer; begin tmp := 0; e := 1; for i := 1 to length(_S) do begin tmp := tmp + ord(_S [ i ]) * e; e := e * b; end; Hash := tmp mod H; end;

procedure TCarsMngm.HCreate(_fIn: string); var i: integer; begin AssignFile(fCars, _fIn); reset(fCars); AssignFile(fHash, copy(_fIn, 1, pos('.', _fIn)) + 'hsh'); rewrite(fHash); bCars.Mark := ''; bCars.V := 0; bCars.S := 0; for i := 1 to H do write(fHash, bCars); reset(fHash); while not eof(fCars) do begin read(fCars, bCars); seek(fHash, Hash(bCars.Mark)); write(fHash, bCars); end; close(fHash); end;

function TCarsMngm.HSearch(_fIn: string; _SI: string):string; begin AssignFile(fHash, _fIn); reset(fHash); seek(fHash, Hash(_SI)); read(fHash, bCars); HSearch := FloatToStrF(bCars.V, ffFixed, 1,3) + ' ' + intToStr(bCars.S); close(fHash); end;