unit FileProc;
{=================================================================}
{  Версия файла 3.0.000                                           }
{  от 4 декабря 2002 г.                                           }
{==========================} interface {==========================}

uses WinTypes,WinProcs,classes,SysUtils,Dialogs,GlType,GlProc;


function fl_GetParamCount(FileName:String):Integer;
function fl_SetIndexes(NamesFile,CfgFile:String;Idns:PIntArr;Cnt:Integer):Integer;
procedure fl_SetParamValues(NamesFile:String;Values:Pointer;DataType:Byte);
procedure fl_SetSortedParamValues(FileName:String;List:TStringList;Values:Pointer;DataType:Byte);
function fl_ReadALOC(InpFile,OutFile:String;IndArr,OpArr:PIntArr;ValArr,SetPntArr:PExtArr):Integer;
function fl_ReadString(S:String;var fComment:Boolean):String;
function QuickIndexOfStr(S:String;List:TStringList):Integer;
function SetUnikName(Name : String;List : TStringList;aSorted:Boolean):String;
{##############################################################################}

                         IMPLEMENTATION

{##############################################################################}
uses math;
//------------------------------------------------------------------------------
function QuickIndexOfStr(S:String;List:TStringList):Integer;
var ia,ib,ic,
    ja,jb,jc : Integer;
begin
 Result:=-1;
 if not List.Sorted then exit;
 ia:=0;
 ib:=List.Count-1;
 if ia > ib then exit;

 ja:=AnsiCompareStr(S,List[ia]);
 if ja <= 0 then begin
  if ja = 0 then Result:=ia;
  exit
 end;

 jb:=AnsiCompareStr(S,List[ib]);
 if jb >= 0 then begin
  if jb = 0 then Result:=ib;
  exit;
 end;

 while abs(ib-ia) > 0 do begin
  if abs(ib-ia) = 1 then ia:=ib;
  ic:=(ib+ia) div 2;
  jc:=AnsiCompareStr(S,List[ic]);
  if jc < 0 then ib:=ic
   else if jc > 0 then ia:=ic
    else begin
     Result:=ic;
     break
    end;
 end
end;
{-------------------------------------------------------------------------------
 Функция возвращает число ненулевых строк
 в текстовом файле "FileName"
-------------------------------------------------------------------------------}
function fl_GetParamCount(FileName:String):Integer;
var  fText   : TextFile;
     S       : String;
     f       : Boolean;
begin
   AssignFile(fText,ExpandFileName(FileName));
   Reset(fText);
   Result:=0;
   f:=false;
   try
    while not SeekEof(fText) do begin
     ReadLn(fText,S);
     S:=Trim(S);
     S:=fl_ReadString(S,f);
     if S <> '' then Inc(Result)
    end;
   finally
    CloseFile(fText);
   end;
end;
{-------------------------------------------------------------------------------
 ВХОДНЫЕ ПАРАМЕТРЫ:
 NamesFile - имя текстового файла с именами сигналов, индексы которых в общем
             списке имен необходимо определить.
 CfgFile   - имя текстового файла с общим списком имен сигналов.

 ВЫХОДНЫЕ ПАРАМЕТРЫ:
 Idns      - указатель на массив целых чисел (Int*4), после выполнения подпрограммы
             массив содержит индексы имен, прочитанных из файла NamesFile,
             в общем списке имен, прочитанных из файла CfgFile.

 ПРИМЕЧАНИЯ:
 1.Каждое имя сигнала должно быть записано на отдельной строке файла,
   в качестве имени сигнала принимается часть строки до первого пробела.
 2.Память под массив Idns должна быть уже выделена
 3.Индексация начинается с 0.

 В случае успеха функция возвращает 0; если имя сигнала не найдено в общем списке
 сигналов, то функция возвращает индекс (начиная с 1) последнего ненайденного сигнала
 в файле NamesFile

-------------------------------------------------------------------------------}
function fl_SetIndexes(NamesFile,CfgFile:String;Idns:PIntArr;Cnt:Integer):Integer;
var  i,k        : Integer;
     f          : Boolean;
     fName,fCfg : TextFile;
     SortedLst,
     Lst        : TStringList;
     S,S1,SS    : String;
     Indexes    : array of Integer;
begin
   Result:=0;
   AssignFile(fName,ExpandFileName(NamesFile));
   Reset(fName);
   AssignFile(fCfg,ExpandFileName(CfgFile));
   Reset(fCfg);

   SortedLst:=TStringList.Create;SortedLst.Sorted:=True;
   Lst:=TStringList.Create;
   FillChar(Idns^,Cnt*SOfI,-1);

   try
    f:=false;
    while not SeekEof(fCfg) do begin
     ReadLn(fCfg,S);
     S:=Trim(S);
     S:=fl_ReadString(S,f);
     if S = '' then continue;
     Str2Args(S,2,[nil,@SS],[TInt4,TStr],' ');
     Lst.Add(SS);
     SortedLst.Add(SS);
    end;

    SetLength(Indexes,Lst.Count*SOfI);
    for i:=0 to Lst.Count-1 do begin
     k:=QuickIndexOfStr(Lst[i],SortedLst);
     Indexes[k]:=i;
    end;

    f:=false;
    i:=0;S1:='';
    while not SeekEof(fName) do begin
     ReadLn(fName,S);
     S:=Trim(S);
     S:=fl_ReadString(S,f);
     if S = '' then continue;
     Str2Args(S,2,[nil,@SS],[TStr,TStr],' ');
     k:=QuickIndexOfStr(SS,SortedLst);
     if k >= 0 then begin
      Idns^[i]:=Indexes[k]+1;
      inc(i)
     end else S1:=S1+'"'+SS+'" ';
    end;

    if S1 <> '' then ShowMessage('В файле "'+CfgFile+'" не найдены сигналы '+S1);
   finally
    CloseFile(fCfg);
    CloseFile(fName);
    SortedLst.Free;
    Lst.Free;
    SetLength(Indexes,0);
   end;
end;
{-------------------------------------------------------------------------------
 ВХОДНЫЕ ПАРАМЕТРЫ:
 NamesFile - имя текстового файла с именами и значениями сигналов.
 DataType  - тип данных, на которые указывает Values.
             Возможные значения DataType:
             0 - Values - указатель на массив Real*8
             1 - Values - указатель на массив Real*4
             2 - Values - указатель на массив Byte
             3 - Values - указатель на массив указателей на массив Real*8

 ВЫХОДНЫЕ ПАРАМЕТРЫ:
 Values    - указатель на структуру данных, которую необходимо заполнить
             значениями.
 ПРИМЕЧАНИЯ:
 1.Каждое имя сигнала должно быть записано на отдельной строке файла,
   в качестве имени сигнала принимается часть строки до первого пробела справа.
 2.Значение сигнала стоит в строке после имени сигнала и отделено от последнего
   любым количеством пробелов.
 3.Память под массив Values должна быть уже выделена
-------------------------------------------------------------------------------}
procedure fl_SetParamValues(NamesFile:String;Values:Pointer;DataType:Byte);
var  k,j    : Integer;
     f      : Boolean;
     fName  : TextFile;
     S      : String;
     x      : Single;
begin
   AssignFile(fName,ExpandFileName(NamesFile));
   Reset(fName);
   try
    k:=0;
    f:=false;
    while not SeekEof(FName) do begin
     ReadLn(FName,S);
     S:=Trim(S);
     S:=fl_ReadString(S,f);
     if S = '' then continue;
     j:=Pos('=',S);
     if j = 0 then x:=0 else begin
      Delete(S,1,j);
      S:=Trim(S);
      try
       x:=StrToFloat(S)
      except
       x:=0
      end
     end;

     case DataType of
      0: PExtArr(Values)^[k]:=x;
      1: PSglArr(Values)^[k]:=x ;
      2: PByteArr(Values)^[k]:=Byte(Round(x));
      3: PExtPtrArr(Values)^[k]^[0]:=x;
     end;
     inc(k)
    end;
   finally
    CloseFile(fName);
   end;
  end;
{-------------------------------------------------------------------------------
 ВХОДНЫЕ ПАРАМЕТРЫ:
 NamesFile - имя текстового файла с именами и значениями сигналов.
 DataType  - тип данных, на которые указывает Values.
             Возможные значения DataType:
             0 - Values - указатель на массив Real*8
             1 - Values - указатель на массив Real*4
             2 - Values - указатель на массив Byte
             3 - Values - указатель на массив указателей на массив Real*8
 List      - список имен сигналов, значения которых должны быть считаны из
             файла NamesFile

 ВЫХОДНЫЕ ПАРАМЕТРЫ:
 Values    - указатель на структуру данных, которую необходимо заполнить
             значениями.
 ПРИМЕЧАНИЯ:
 1.Каждое имя сигнала должно быть записано на отдельной строке файла,
   в качестве имени сигнала принимается часть строки до первого пробела справа.
 2.Значение сигнала стоит в строке после имени сигнала и отделено от последнего
   любым количеством пробелов.
 3.Память под массив Values должна быть уже выделена
-------------------------------------------------------------------------------}
procedure fl_SetSortedParamValues(FileName:String;List:TStringList;Values:Pointer;DataType:Byte);
var  k,j    : Integer;
     f      : Boolean;
     fName  : TextFile;
     S,
     Code   : String;
     x      : Double;
begin
   AssignFile(fName,ExpandFileName(FileName));
   Reset(fName);
   try
    f:=false;
    while not SeekEof(FName) do begin
     ReadLn(FName,S);
     S:=Trim(S);
     S:=fl_ReadString(S,f);
     if S = '' then continue;
     Code:='';
     j:=Pos(' ',S);
     if j = 0 then x:=0 else begin
      Code:=Copy(S,1,j-1);
      Delete(S,1,j);
      S:=Trim(S);
      try
       x:=StrToFloat(S)
      except
       x:=0
      end
     end;

     k:=List.IndexOf(Code);
     if (k >=0) and (k < List.Count) then
      case DataType of
       0: PExtArr(Values)^[k]:=x;
       1: PSglArr(Values)^[k]:=x ;
       2: PByteArr(Values)^[k]:=Byte(Round(x));
       3: PExtPtrArr(Values)^[k]^[0]:=x;
      end;
    end;
   finally
    CloseFile(fName);
   end;
  end;

{-------------------------------------------------------------------------------
 ВХОДНЫЕ ПАРАМЕТРЫ:
 InpFile - имя текстового файла с именами сигналов, индексы которых в общем
           списке имен необходимо определить.
 OutFile   - имя текстового файла с общим списком имен сигналов.

 ВЫХОДНЫЕ ПАРАМЕТРЫ:
 Idns      - указатель на массив целых чисел (Int*4), после выполнения подпрограммы
             массив содержит индексы имен, прочитанных из файла NamesFile,
             в общем списке имен, прочитанных из файла CfgFile.

 ПРИМЕЧАНИЯ:
 1.Каждое имя сигнала должно быть записано на отдельной строке файла,
   в качестве имени сигнала принимается часть строки до первого пробела.
 2.Память под массив Idns должна быть уже выделена
 3.Индексация начинается с 0.


-------------------------------------------------------------------------------}
function fl_ReadALOC(InpFile,OutFile:String;IndArr,OpArr:PIntArr;ValArr,SetPntArr:PExtArr):Integer;
var  i,j,k,
     k1,k2       : Integer;
     InpIndex,
     OutIndex    : Integer;
     fComment,
     fErr,f,fWarn: Boolean;
     Value       : RealType;
     SetPnt      : RealType;
     Op          : TopType;
     fInp,fOut   : TextFile;
     InpList,
     OutList     : TStringList;
     Code,S,
     FullCode,
     sValue,
     sErr,sWarn  : String;
label 1;
begin
   Result:=0;
   AssignFile(fInp,ExpandFileName(InpFile));
   Reset(fInp);
   AssignFile(fOut,ExpandFileName(OutFile));
   Reset(fOut);

   InpList:=TStringList.Create;
   OutList:=TStringList.Create;

   try

    i:=0;
    fComment:=False;
    fErr:=False;
    sErr:='Файл "' + InpFile+ '". Ошибка в строках № "';
    while not SeekEof(FInp) do begin
     Inc(i);
     ReadLn(fInp,S);
     S:=Trim(S);
     S:=fl_ReadString(S,fComment);
     if S = '' then continue;
     f:=Str2Args(S,2,[@InpIndex,@Code],[TInt4,TStr],' ');
     if not f then begin
      fErr:=True;
      sErr:=sErr+IntToStr(i)+'  ';
     end;
     InpList.Add(Code);
     InpList.Values[Code]:=IntToStr(InpIndex);
    end;

    if fErr then goto 1;

    fComment:=False;
    fErr:=False;fWarn:=False;
    sErr:='Файл "'  + OutFile + '". Ошибка в строках № "';
    sWarn:='Файл "' + InpFile + '". Не найдены коды "';
    i:=0;j:=0;
    while not SeekEof(fOut) do begin
     inc(i);
     Readln(fOut,S);
     S:=Trim(S);
     S:=fl_ReadString(S,fComment);
     if S = '' then continue;

     f:=Str2Args(S,4,[@OutIndex,@FullCode,@Op,@SetPnt],[TInt4,TStr,TOp,TReal8],' ');
     FullCode:=Trim(FullCode);
     k1:=Pos('=',FullCode);
     k2:=Pos(':',FullCode);
     if (k1 = 0) or (k2 = 0) then k:=max(k1,k2) else k:=min(k1,k2);

     if k = 0 then Code:=FullCode else Code:=Copy(FullCode,1,k-1);

     if k1 = 0 then Value:=0 else begin
      if k2 < k1 then sValue:=Copy(FullCode,k1+1,Length(FullCode))
       else sValue:=Copy(FullCode,k1+1,k2-1);
      f:=f and Str2Args(sValue,1,[@Value],[TReal8],' ');
     end;

{     if k2 = 0 then Value:=0 else begin
      if k2 < k1 then sValue:=Copy(FullCode,k1+1,Length(FullName))
       else sValue:=Copy(FullCode,k1+1,k2-1);
      f:=f or Str2Args(sValue,1,[@Value],[TReal8],' ');
     end;}

     if not f then begin
      fErr:=True;
      sErr:=sErr+IntToStr(i)+'  ';
     end;

     k:=InpList.IndexOf(Code);
     if k >= 0 then begin
      InpIndex:=StrToInt(InpList.Values[Code]);
      IndArr^[j]:=InpIndex-1;
     end else begin
      fWarn:=True;
      IndArr^[j]:=-1;
      sWarn:=sWarn+Code+'  ';
     end;

     if OpArr <> nil then OpArr^[j]:=Ord(Op);

     if ValArr <> nil then ValArr^[j]:=Value;

     if SetPntArr <> nil then SetPntArr^[j]:=SetPnt;

     Inc(j);
    end;
1:
   finally
    if fErr then begin
     ShowMessage(sErr+'"');
     Result:=er_ReadFile;
    end;

    if fWarn then ShowMessage(sWarn+'"');

    CloseFile(fInp);
    CloseFile(fOut);
    InpList.Free;
    OutList.Free;
   end;
end;

{-------------------------------------------------------------------------------
 ВХОДНЫЕ ПАРАМЕТРЫ:
 ВЫХОДНЫЕ ПАРАМЕТРЫ:
-------------------------------------------------------------------------------}
function fl_ReadString(S:String;var fComment:Boolean):String;
var  j1,j2  : Integer;
begin
   S:=Trim(S);
   Result:=S;
   j1:=Pos('{',S);
   if (j1 = 0)and(not fComment) then exit
   else begin
    j2:=Pos('}',S);
    if not fComment then Result:=Copy(S,1,j1-1) else Result:='';
    fComment:=j2 = 0;
    if not fComment then Result:=Result+Copy(S,j2+1,Length(S));
    Result:=Trim(Result)
   end;
end;
//-------------------------------------------------------------------------
function SetUnikName(Name : String;List : TStringList;aSorted:Boolean):String;
var k,j : Integer;
    S   : String;
begin
  S:=Name;
  j:=0;
  repeat
   if aSorted then k:=QuickIndexOfStr(S,List) else k:=List.IndexOf(S);
   if k >= 0 then begin
    inc(j);
    S:=Name+IntToStr(j);
   end;
  until k < 0;
  Result:=S
end;
END.