Доработка файлов по 365-П (GUID, переименование, поиск ошибок и т.д.)

unit main; 

interface 

uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, StrUtils, DateUtils, ComCtrls, ExtCtrls, ToolWin; 

type 
  TForm1 = class(TForm) 
    Go_Button:   TButton; 
    OpenDialog1: TOpenDialog; 
    OpenButton:  TButton; 
    SaveDialog1: TSaveDialog; 
    BtnRe: TButton; 
    ToolBar1: TToolBar; 
    Panel1: TPanel; 
    StatusBar1: TStatusBar; 
    ProgressBar1: TProgressBar; 
    SrcOpenDialog: TOpenDialog; 
    MProtocol: TRichEdit; 
    procedure FormCreate(Sender: TObject); 
    procedure BtnReClick(Sender: TObject); 
    procedure OpenButtonClick(Sender: TObject); 
    procedure Go_ButtonClick(Sender: TObject); 
    function  ToOEM(S:String):String; 
    function  ToAnsi(S:String):String; 
    function  WriteLog(Level:Integer; S:String):String; 
    function  FileSizeByName(Name:String): Integer; 
    function  isNum(const st:string): boolean; 

  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 
const 
  OstPref='BOS1_'; 
  OstSrcPref='RBN'; 
  OperPref='BV100_'; 
  OperSrcPref='ZNO'; 
  NalschPref='BNS1_'; 
  NalschSrcPref='ZNO'; 
  ReceiptPref='PB1_'; 
  ChunkLimit=470000;    //524288 - 512К 
  Bic='10813823'; 
  INN='7744001497'; 
  ERR=0; 
  WARN=1; 
  INFO=2; 

var 
  Form1: TForm1; 
  InFile,OutFile: TextFile; 
  CurrentFileNum,NumOutFiles,OutFileSize: Integer; 
  SIn,SOut: String; 
  InFileSize, InFilePosition: Integer; 
  DateZapr,KodNO,NomZapr,NomResh,DateResh :String; 
  NumericTags: TStringList; 

implementation 

{$R *.dfm} 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  DateZapr:=''; 
  NomZapr:=''; 
  NomResh:=''; 
  DateResh:=''; 
  NumericTags := TStringList.Create; 
  NumericTags.Add('ИННКО'); 
  NumericTags.Add('КППКО'); 
  NumericTags.Add('БИК'); 
  NumericTags.Add('ИНННП'); 
  NumericTags.Add('КППНП'); 
  NumericTags.Add('НомСчПП'); 
  NumericTags.Add('НомСч'); 
  NumericTags.Add('БИКБП'); 
  NumericTags.Add('НомКоррСч'); 
  NumericTags.Add('НомДок'); 
  NumericTags.Sort; //for Find method! 
end; 

procedure TForm1.OpenButtonClick(Sender: TObject); 
begin 
  OpenDialog1.execute; 
  DateZapr:=''; 
  NomZapr:=''; 
  NomResh:=''; 
  DateResh:=''; 
  MProtocol.Text:=''; 
  WriteLog(INFO,'Файл к обработке: '+OpenDialog1.Filename+''#13+#10); 
end; 

procedure TForm1.BtnReClick(Sender: TObject); 
var 
  FileName,DateStr: String; 
  NameLength: Integer; 
  Today: TDateTime; 
begin 
//Формирование подтерждения по заданному файлу 
//ZNO10813823_774820120203_000594### 
//10@@@ 
//2012-02-06@@@ 
//10:35:37@@@ 
//=== 
    if (AnsiPos('.',ExtractFileName(OpenDialog1.FileName))<>0) then 
      SaveDialog1.FileName:=ReceiptPref+MidStr(ExtractFileName(OpenDialog1.FileName),1,AnsiPos('.',ExtractFileName(OpenDialog1.FileName))-1)+'.TXT'
    else 
      SaveDialog1.FileName:=ReceiptPref+ExtractFileName(OpenDialog1.FileName)+'.TXT'; 
    SaveDialog1.Execute; 
    WriteLog(INFO,'Имя файла подтверждения: '+SaveDialog1.FileName+''#13+#10); 
    Rewrite(OutFile,SaveDialog1.FileName); 
    FileName:=ExtractFileName(OpenDialog1.FileName); 
    Writelog(INFO,''#13+#10); // empty line before receipt 
    Write(OutFile,MidStr(FileName,1,Length(FileName)-4)+'###'+''#13+#10); 
    WriteLog(INFO,MidStr(FileName,1,Length(FileName)-4)+'###'+''#13+#10); 
    Write(OutFile,'10@@@'+''#13+#10); 
    Writelog(INFO,'10@@@'+''#13+#10); 
    DateStr:=DateToStr(Now); 
    Write(OutFile,MidStr(DateStr,7,4)+'-'+MidStr(DateStr,4,2)+'-'+MidStr(DateStr,1,2)+'@@@'+''#13+#10); 
    Writelog(INFO,MidStr(DateStr,7,4)+'-'+MidStr(DateStr,4,2)+'-'+MidStr(DateStr,1,2)+'@@@'+''#13+#10); 
    Write(OutFile,TimeToStr(Now)+'@@@'+''#13+#10); 
    Writelog(INFO,TimeToStr(Now)+'@@@'+''#13+#10); 
    Write(OutFile,'==='+''#13+#10); 
    Writelog(INFO,'==='+''#13+#10); 
    Flush(OutFile); 
    CloseFile(OutFile); 
end; 

procedure TForm1.Go_ButtonClick(Sender: TObject); 
var 
  Id: TGUID; 
  StringNo, StringCount,Code: Integer; 
  Tag,Val,HeaderTag,HeaderVal,StrNo,StrFileNo,StrNumOutFiles,DateForName,NomForName, InfType, Pref:  String; 
  TagLength,HeaderTagLength,i:  Integer; 
  RetCode:Boolean; 
  TopHeader,ThirdHeader: Array of String; 
  TopHeaderLength,ThirdHeaderLength,HeaderState: Integer; 
  Index: Integer; 
begin 
  CurrentFileNum:=1; 
  OutFileSize:=0; 
  InFilePosition:=0; 
  MProtocol.Text:=''; 
  WriteLog(INFO,'Файл к обработке: '+OpenDialog1.Filename+''#13+#10); 
  if not (FileExists(OpenDialog1.Filename)) then  exit; 
  InFileSize:=FileSizeByName(OpenDialog1.Filename); 
  ProgressBar1.Min:=0; 
  ProgressBar1.Max:=InFileSize; 
  ProgressBar1.Position:=0; 
  AssignFile(InFile,OpenDialog1.Filename); 
//  Rewrite(OutFile, OpenDialog1.Filename+'.chk1'); 
  Rewrite(OutFile, OpenDialog1.Filename+'.chk'+Format('%.2d',[CurrentFileNum])); 
  Reset(InFile); 
  if InFileSize > ChunkLimit then 
  begin 
    WriteLog(WARN,'Размер файла больше предельного размера одной части'#13+#10); 
    NumOutFiles:=(InFileSize div ChunkLimit)+1; 
    Str(NumOutFiles,StrNumOutFiles); 
  end; 
  HeaderState:=0; 
  TopHeaderLength:=0; 
  ThirdHeaderLength:=0; 
  while not Eof(InFile) do 
  begin 
    Readln(InFile, SIn); 
    SOut:=ToAnsi(SIn); 
    if HeaderState < 3 then //Еще не считали все заголовки 
    begin 
      if HeaderState=0 then 
      begin //read top header 
        TopHeaderLength:=TopHeaderLength+1; 
        SetLength(TopHeader,TopHeaderLength); 
        TopHeader[TopHeaderLength-1]:=SOut; 
      end; 
      if HeaderState=2 then 
      begin //read 3rd header 
        ThirdHeaderLength:=ThirdHeaderLength+1; 
        SetLength(ThirdHeader,ThirdHeaderLength); 
        ThirdHeader[ThirdHeaderLength-1]:=SOut; 
      end; 
      if SOut='###' then HeaderState:=HeaderState+1; 
    end; 
    StringNo:=StringNo+1; 
    Str(StringNo,StrNo); 
    TagLength:=AnsiPos(':',SOut)-1; 
    if TagLength<>-1 then 
    begin 
      Tag:=MidStr(SOut,1,TagLength); 
      Val:=MidStr(SOut,TagLength+2,Length(SOut)-TagLength-1); 
      if (Tag = 'НомСч') and (HeaderState >=3) then // found new 3rd header when already read top 3 headers 
      begin 
        HeaderState:=2;   //return to 3rd header mode 
        ThirdHeaderLength:=1; //set 1st line of 3rd header 
        ThirdHeader[ThirdHeaderLength-1]:=SOut; // write it down 
        WriteLog(INFO,'Строка '+StrNo+' - Найдено:'+SOut); 
      end; 
      if Tag = 'ТипИнф' then 
      begin 
          InfType:=Val; 
          WriteLog(INFO,'Строка '+StrNo+' - Найден ТипИнф:'+InfType); 
      end; 
      if Tag = 'ИдФайл' then 
      begin 
          CreateGUID(Id); 
          SOut:='ИдФайл:'+ Val + MidStr(GUIDToString(Id),2,36); 
          WriteLog(INFO,'Строка '+StrNo+' - Добавлен GUID к ИдФайл'); 
      end; 
      if Tag = 'КодНО' then 
      begin 
          KodNO:=Val; 
          WriteLog(INFO,'Строка '+StrNo+' - Найден  КодНО:'+KodNO); 
      end; 
      if Tag = 'ИдДок' then 
      begin 
          CreateGUID(Id); 
          SOut:='ИдДок:'+ MidStr(GUIDToString(Id),2,36); 
          WriteLog(INFO,'Строка '+StrNo+' - добавлен GUID к ИдДок'); 
      end; 
      if (Tag = 'НомЧасти') and (InFileSize <= ChunkLimit) then 
      begin 
          SOut:=''; 
          WriteLog(INFO,'Строка '+StrNo+' - Удален НомЧасти'); 
      end; 
      if (Tag = 'КолДок') and (InFileSize > ChunkLimit) then 
      begin 
          SOut:='КолДок:'+StrNumOutFiles; 
          WriteLog(INFO,'Строка '+StrNo+' - КолДок исправлен'); 
      end; 
      if Tag = 'НомЗапр' then 
      begin 
        NomZapr:=''; 
        for i := length(Val) to 6 - 1 do   NomZapr:=NomZapr+'0'; 
          NomZapr:=NomZapr+Val; 
          WriteLog(INFO,'Строка '+StrNo+' - Найден НомЗапр:'+NomZapr); 
      end; 
      if Tag = 'ДатаЗапр' then 
      begin 
          DateZapr:=MidStr(Val,7,4)+MidStr(Val,4,2)+MidStr(Val,1,2); 
          WriteLog(INFO,'Строка '+StrNo+' - Найдена ДатаЗапр:'+DateZapr); 
      end; 
      if Tag = 'НомРеш' then 
      begin 
        NomResh:=''; 
        for i := length(Val) to 6 - 1 do   NomResh:=NomResh+'0'; 
          NomResh:=NomResh+Val; 
          WriteLog(INFO,'Строка '+StrNo+' - Найден НомРеш:'+NomResh); 
      end; 
      if Tag = 'ДатаРеш' then 
      begin 
          DateResh:=MidStr(Val,7,4)+MidStr(Val,4,2)+MidStr(Val,1,2); 
          WriteLog(INFO,'Строка '+StrNo+' - Найдена ДатаРеш:'+DateResh); 
      end; 
      if (NumericTags.Find(Tag,index)) then // Проверка корректности значений числовых тегов 
      begin 
          if not isNum(Val) then 
            WriteLog(ERR,'Строка '+StrNo+' - Ошибка: Не числовые значения:'+Tag+':'+Val); 
      end; 
      if (Val='') and (Tag<>'ИдДок') then // Только последним, после обработки других 
      begin 
          WriteLog(WARN,'Строка '+StrNo+' - Обнаружен пустой тег:'+Tag); 
      end; 
    end 
    else //No tags found! 
    begin 
      if (AnsiPos('Ошибка',SOut))<>0 then 
      begin 
          WriteLog(ERR,'Строка '+StrNo+' - Найдена ошибка: '+SOut); 
      end; 
      if (AnsiPos('Ожидается',SOut))<>0 then 
      begin 
          WriteLog(ERR,'Строка '+StrNo+' - Найдена ошибка: '+SOut); 
      end; 
    end; 
    if SOut<>'' then 
    begin 
      Writeln(OutFile,ToOEM(SOut)); 
      OutFileSize:=OutFileSize+Length(SOut); 
      InFilePosition:=InFilePosition+Length(SOut); 
      ProgressBar1.Position:=InFilePosition; 
      if  (OutFileSize > ChunkLimit) and (TagLength =-1) then 
      //достигли предела и не в середине документа 
      begin 
          Writeln(OutFile,'@@@'); 
          Writeln(OutFile,'==='); 
          OutFileSize:=0; 
          Flush(OutFile); 
          CloseFile(OutFile); 
          CurrentFileNum:=CurrentFileNum+1; 
          StrFileNo:=Format('%.2d',[CurrentFileNum]);  // for filename - with leading zero's 
          WriteLog(INFO,'Строка '+StrNo+' - Начало части '+StrFileNo); 
          Rewrite(OutFile, OpenDialog1.Filename+'.chk'+StrFileNo); 
          Str(CurrentFileNum,StrFileNo);              // for tag in the file - without leading zeros 
          for i:=0 to TopHeaderLength - 1 do 
          begin 
            HeaderTagLength:=AnsiPos(':',TopHeader[i])-1; 
            HeaderTag:=MidStr(TopHeader[i],1,HeaderTagLength); 
            HeaderVal:=MidStr(TopHeader[i],HeaderTagLength+2,Length(TopHeader[i])-HeaderTagLength-1); 
            if HeaderTag='ИдФайл' then 
              TopHeader[i]:='ИдФайл:'+ MidStr(HeaderVal,1,29) + MidStr(GUIDToString(Id),2,36); 
            if HeaderTag='НомЧасти' then 
              TopHeader[i]:='НомЧасти:'+ StrFileNo; 
            if HeaderTag='КолДок' then 
              TopHeader[i]:='КолДок:'+ StrNumOutFiles; 
            Writeln(OutFile,ToOEM(TopHeader[i])); 
          end; 
          Writeln(OutFile,ToOEM('@@@')); // добавить недостающие собаки после первого заголовка 
          for i:=0 to ThirdHeaderLength - 1 do 
            Writeln(OutFile,ToOEM(ThirdHeader[i])); 
      end; 
    end; 
  end; 
  Flush(OutFile); 
  CloseFile(OutFile); 
  SaveDialog1.FileName:=''; 
  if MessageDlg('Исходный запрос был получен электронно?', mtConfirmation, [mbYes, mbNo], 0) = mrYes then 
  begin 
     SrcOpenDialog.Title:='Выберите файл исходного запроса'; 
     SrcOpenDialog.Execute(); 
     SaveDialog1.FileName:=MidStr(ExtractFileName(SrcOpenDialog.FileName),1,AnsiPos('.',ExtractFileName(SrcOpenDialog.FileName))-1); 
     if (InfType='ОСТАТКИ')      then Pref:=OstPref; 
     if (InfType='ОПЕРАЦИИПОСЧ') then Pref:=OperPref; 
     if (InfType='НАЛСЧЕТОВ')    then Pref:=NalschPref; 
     SaveDialog1.FileName:=Pref+SaveDialog1.FileName; 
  end 
  else // create name from file contents 
  begin 
     if (InfType='ОСТАТКИ')      then 
      SaveDialog1.FileName:=OstPref+OstSrcPref+Bic+'_'+KodNO+DateResh+'_'+NomResh; 
     if (InfType='ОПЕРАЦИИПОСЧ') then 
    SaveDialog1.FileName:=OperPref+OperSrcPref+Bic+'_'+KodNO; 
     if (InfType='НАЛСЧЕТОВ')  then 
    SaveDialog1.FileName:=NalschPref+NalschSrcPref+Bic+'_'+KodNO; 
     if ((InfType='ОПЕРАЦИИПОСЧ') or (InfType='НАЛСЧЕТОВ')) then 
    SaveDialog1.FileName:=SaveDialog1.FileName+DateZapr+'_'+NomZapr; 
  end; 
  SaveDialog1.FileName:=SaveDialog1.FileName+'.TXT'; 
  ProgressBar1.Position:=0; 
  if SaveDialog1.Execute then 
  begin 
    if NumOutFiles > 1 then 
    begin // больше чем один файл - нумеруем с "1" 
      for i := 1 to NumOutfiles do 
      begin 
//      Str(i,StrFileNo); 
        StrFileNo:=Format('%.2d',[i]); 
        RetCode:=RenameFile(OpenDialog1.Filename+'.chk'+StrFileNo, ReplaceStr(SaveDialog1.FileName,'BV100','BV1'+StrFileNo)); 
        if RetCode=false then 
          MessageDlg('Невозможно сохранить файл '+ReplaceStr(SaveDialog1.FileName,'BV100','BV1'+StrFileNo), mtError,[mbOk], 0, mbOk) 
        else 
          MessageDlg('Файл сохранен как: '+ReplaceStr(SaveDialog1.FileName,'BV100','BV1'+StrFileNo),mtInformation,[mbOk], 0, mbOk); 
      end; 
    end 
    else // один файл нумеруется с "0" 
    begin 
      StrFileNo:='01'; 
      RetCode:=RenameFile(OpenDialog1.Filename+'.chk'+StrFileNo,SaveDialog1.FileName); 
      if RetCode=false then 
        MessageDlg('Невозможно сохранить файл '+SaveDialog1.FileName, mtError,[mbOk], 0, mbOk) 
      else 
        MessageDlg('Файл сохранен как: '+SaveDialog1.FileName,mtInformation,[mbOk], 0, mbOk); 
    end; 
  end; 
end; 

function TForm1.WriteLog(Level:Integer; S:String):String; 
var 
  AColor:Integer; 
begin 
  case Level of 
    ERR : AColor := clRed; 
    INFO: AColor := clLime; 
    WARN: AColor := clYellow; 
  else 
    AColor := clLime; 
  end; 
  with MProtocol do 
   begin 
     SelStart := Length(Text); 
     SelAttributes.Color := AColor; 
     Lines.Add(S); 
   end; 
  MProtocol.SelStart := MaxInt; 
  SendMessage(MProtocol.handle, EM_SCROLLCARET,0,0); 
  Result:=S; 
end; 

function TForm1.ToOEM(S:String):String; 
{ ConvertAnsiToOem translates a string into the OEM-defined character set } 
{$IFNDEF WIN32} 
var 
  Source, Dest : array[0..255] of Char; 
{$ENDIF} 
begin 
  {$IFDEF WIN32} 
  SetLength(Result, Length(S)); 
  if Length(Result) > 0 then 
    AnsiToOem(PChar(S), PChar(Result)); 
  {$ELSE} 
  if Length(Result) > 0 then 
  begin 
    AnsiToOem(StrPCopy(Source, S), Dest); 
    Result := StrPas(Dest); 
  end; 
  {$ENDIF} 
end; { ConvertAnsiToOem } 

function TForm1.ToAnsi(S:String):String; 
{ ConvertOemToAnsi translates a string into the OEM-defined character set } 
{$IFNDEF WIN32} 
var 
  Source, Dest : array[0..255] of Char; 
{$ENDIF} 
begin 
  {$IFDEF WIN32} 
  SetLength(Result, Length(S)); 
  if Length(Result) > 0 then 
    OemToAnsi(PChar(S), PChar(Result)); 
  {$ELSE} 
  if Length(Result) > 0 then 
  begin 
    OemToAnsi(StrPCopy(Source, S), Dest); 
    Result := StrPas(Dest); 
  end; 
  {$ENDIF} 
end; { ConvertOemToAnsi } 

function  TForm1.FileSizeByName(Name:String): Integer; 
var 
  F: File of byte; 
begin 
  AssignFile(F, Name); 
  Reset(F); 
  Result:=FileSize(F); 
  CloseFile(F); 
end; 

function TForm1.isNum(const st:string): boolean; 
var 
  i: Integer; 
begin 
  isNum:=True; 
  for i := 1 to Length(st) do 
    if not (st[i] in ['0'..'9']) then isNum:=False; 
end; 

end.