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.
