Загрузка в Диасофт FA# 5NT из 4х4 с поиском фамилий и счетов регэкспами

Программка берет из командной строки имя файла, в котором содержатся платежи в формате Диасофт 4х4. Загружает их, находит в назначении платежа с помощью регулярных выражений (библиотека Copyright (c) 1999-2004 Andrey V. Sorokin, St.Petersburg, Russia) ФИО, номер счета. Затем выгружает текстовые файлы, пригодные к загрузке в Диасофт FA# 5NT, в каталоги, необходимые для последующей загрузки.
Основное назначение - автоматизировать зачисление пришедших на физиков платежей с реквизитами счетов в назначении платежа.

unit SDIMAIN; 

interface 

uses Windows, Classes, Graphics, Forms, Controls, Menus, 
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, ImgList, StdActns, 
  ActnList, ToolWin, Grids, SysUtils, StrUtils, RegExpr; 

type 
  TMyGrid=class(TCustomGrid); 

  TSDIAppForm = class(TForm) 
    OpenDialog: TOpenDialog; 
    SaveDialog: TSaveDialog; 
    ToolBar1: TToolBar; 
    ToolButton1: TToolButton; 
    SaveButton: TToolButton; 
    ActionList1: TActionList; 
    FileNew1: TAction; 
    FileOpen1: TAction; 
    FileSave1: TAction; 
    FileSaveAs1: TAction; 
    FileExit1: TAction; 
    EditCut1: TEditCut; 
    EditCopy1: TEditCopy; 
    EditPaste1: TEditPaste; 
    HelpAbout1: TAction; 
    StatusBar: TStatusBar; 
    ImageList1: TImageList; 
    Panel1: TPanel; 
    StringGrid1: TStringGrid; 
    DelBtn: TBitBtn; 
    ToolButton3: TToolButton; 
    BtnSaveToCard: TBitBtn; 
    procedure BtnSaveToCardClick(Sender: TObject); 
  
    procedure DelBtnClick(Sender: TObject); 
    function  ToOEM(S:String):String; 
    function  ToAnsi(S:String):String; 
    function  LeftPad(S: string; Ch: Char; Len: Integer): string; 
    function  RightPad(S: string; Ch: Char; Len: Integer): string; 
    procedure LoadInFile(); 
    procedure FormShow(Sender: TObject); 
    procedure FileNew1Execute(Sender: TObject); 
    procedure FileOpen1Execute(Sender: TObject); 
    procedure FileSave1Execute(Sender: TObject); 
    procedure FileExit1Execute(Sender: TObject); 
    procedure DeleteARow(Grid: TStringGrid; ARow: Integer); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 

var 
  SDIAppForm: TSDIAppForm; 
  STag,Val: String; 
  SIn,SOut: String; 
  FamilyName,FirstName,SurName: String; 
  InFile,OutFile: TextFile; 
  TagLength:  Integer; 
  RegExp: TRegExpr; 
  Colwidths: array[0..6] of integer = (25,18,18,3,20,31,250); 
  // !!! This for 5NT File, don't touch 
implementation 


{$R *.dfm} 



procedure TSDIAppForm.DelBtnClick(Sender: TObject); 
begin 
  DeleteARow(StringGrid1, StringGrid1.Row); 
end; 

procedure TSDIAppForm.DeleteARow(Grid: TStringGrid;   ARow: Integer); 
begin 
  TMyGrid(Grid).DeleteRow(ARow); 
end; 

procedure TSDIAppForm.FileNew1Execute(Sender: TObject); 
begin 
  { Do nothing } 
end; 

procedure TSDIAppForm.FileOpen1Execute(Sender: TObject); 
begin 
  OpenDialog.Execute; 
  SDIAppForm.caption:='Зачисление переводов - '+ OpenDialog.Filename; 
  if OpenDialog.Filename<>'' then 
  begin 
    DelBtn.Enabled:=false; 
    SaveButton.Enabled:=false; 
    BtnSaveToCard.Enabled:=false; 
    LoadInFile; 
    if (StringGrid1.RowCount > 1) and (StringGrid1.Cells[6,1] <> '') then 
    begin 
      SaveButton.Enabled:=true; 
      BtnSaveToCard.Enabled:=true; 
      Delbtn.Enabled:=true; 
    end; 
  end; 
end; 

procedure TSDIAppForm.LoadInFile; 
var 
  col,row:Integer; 
begin 
  AssignFile(InFile,OpenDialog.Filename); 
  Reset(InFile); 
  StringGrid1.RowCount:=2; 
  row:=0; 
  for col := 0 to 6 do {clear second line} 
  begin 
       StringGrid1.Cells[col,1]:=''; 
  end; 
  while not Eof(InFile) do 
  begin 
    Readln(InFile, SIn); 
    SOut:=ToAnsi(SIn); 
    TagLength:=AnsiPos(':',SIn)-1; 
    if TagLength=-1 then 
    begin 
      STag:=SOut; 
    end 
    else 
    begin 
      STag:=MidStr(SOut,1,TagLength); 
      Val:=MidStr(SOut,TagLength+2,Length(SOut)-TagLength-1); 
    end; 
    if STag='%МЕЖБНКДОК' then 
    begin 
      row:=row+1; 
      if row>1 then 
          StringGrid1.RowCount:=row+1; 
    end; 
    if STag='ВАЛЮТА    ' then 
      StringGrid1.Cells[3,row]:=Val; 
    if STag='СУММА     ' then 
      StringGrid1.Cells[5,row]:=Val; 
    if (midstr(STag,1,4)='ПРИМ') and (length(Val)<>0) then 
      StringGrid1.Cells[6,row]:=StringGrid1.Cells[6,row]+Val; 
    if (midstr(STag,1,4)='%END') then 
    begin 
      try 
        RegExp := TRegExpr.Create; 
        RegExp.Expression := '[А-Я]{1}[а-я]{2,}\s[А-Я]{1}[а-я]{2,}\s[А-Я]{1}[а-я]{2,}'; 
        if RegExp.Exec(StringGrid1.Cells[6,row]) then 
        begin 
          RegExp.Expression := '[А-Я]{1}[А-Яа-я]{2,}'; 
          RegExp.Exec(RegExp.Match[0]); 
          StringGrid1.Cells[0,row]:=RegExp.Match[0]; 
          RegExp.ExecNext; 
          StringGrid1.Cells[1,row]:=RegExp.Match[0]; 
          RegExp.ExecNext; 
          StringGrid1.Cells[2,row]:=RegExp.Match[0]; 
        end; 
        RegExp.Expression := '(40817|42301|42302|42303|42304|42305|42306|42307)[0-9]{15}'; 
        if RegExp.Exec(StringGrid1.Cells[6,row]) then 
        begin 
          StringGrid1.Cells[4,row]:=RegExp.Match[0]; 
        end; 
     finally 
       RegExp.Free; 
     end; 
    end; 
  end; 
  CloseFile(InFile); 
end; 

procedure TSDIAppForm.FileSave1Execute(Sender: TObject); 
  var i,j:Integer; 
      S,Today:string; 
begin 
  Today:=DateTimeToStr(Now); 
  SaveDialog.FileName:='b'+Midstr(Today,9,2)+Midstr(Today,4,2)+Midstr(Today,1,2)+'a.777'; 
  SaveDialog.InitialDir:='c:\ObmenPC40\Dividend\'; 
  SaveDialog.Execute; 
  Rewrite(OutFile,SaveDialog.FileName); 
  for i := 1 to StringGrid1.RowCount - 1 do 
  begin 
      for j := 0 to StringGrid1.ColCount - 1 do 
      begin 
         S:=Trim(Midstr(StringGrid1.Cells[j,i],1,Colwidths[j])); 
         if Colwidths[j]>length(S) then 
            S:=LeftPad(S,' ',Colwidths[j]); 
         Write(OutFile,'  '+ToOEM(S));//!!! 

      end; 
      Write(OutFile,''#13+#10); 
  end; 
  Flush(OutFile); 
  CloseFile(OutFile); 

end; 

procedure TSDIAppForm.BtnSaveToCardClick(Sender: TObject); 
  var i,j:Integer; 
      Today:string; 
begin 
  Today:=DateTimeToStr(Now); 
  SaveDialog.FileName:='b'+Midstr(Today,9,2)+Midstr(Today,4,2)+Midstr(Today,1,2)+'a.777'; 
  SaveDialog.InitialDir:='c:\ObmenPC40\Card\'; 
  SaveDialog.Execute; 
  Rewrite(OutFile,SaveDialog.FileName); 
  for i := 1 to StringGrid1.RowCount - 1 do 
  begin 
      Write(OutFile,Trim(IntToStr(i))); 
      Write(OutFile,'^777'); 
      for j := 0 to StringGrid1.ColCount - 1 do 
      begin 
         Write(OutFile,'^'+ToOEM(Trim(StringGrid1.Cells[j,i])));//!!! 
      end; 
      Write(OutFile,''#13+#10); 
  end; 
  Flush(OutFile); 
  CloseFile(OutFile); 
end; 

procedure TSDIAppForm.FormShow(Sender: TObject); 
var 
   col: Integer; 
begin 
   StringGrid1.ColCount:=7; 
   StringGrid1.RowCount:=2; 
   StringGrid1.FixedRows:=1; 
   StringGrid1.ColWidths[0]:=90;   StringGrid1.Cells[0,0]:='Фамилия'; 
   StringGrid1.ColWidths[1]:=90;  StringGrid1.Cells[1,0]:='Имя'; 
   StringGrid1.ColWidths[2]:=90;   StringGrid1.Cells[2,0]:='Отчество'; 
   StringGrid1.ColWidths[3]:=20;   StringGrid1.Cells[3,0]:='Вал'; 
   StringGrid1.ColWidths[4]:=105;  StringGrid1.Cells[4,0]:='Номер счета'; 
   StringGrid1.ColWidths[5]:=70;   StringGrid1.Cells[5,0]:='Сумма'; 
   StringGrid1.ColWidths[6]:=1180;   StringGrid1.Cells[6,0]:='Примечание'; 
   for col := 0 to 6 do {clear second line} 
   begin 
       StringGrid1.Cells[col,1]:=''; 
   end; 
   DelBtn.Enabled:=false; 
   SaveButton.Enabled:=false; 
   BtnSaveToCard.Enabled:=false; 
   OpenDialog.FileName:= ParamStr(1); 
   SDIAppForm.Caption:='Зачисление переводов - '+ ParamStr(1); 
   if ParamStr(1) <> '' then 
   begin 
     LoadInFile; 
     if (StringGrid1.RowCount > 1) and (StringGrid1.Cells[6,1] <> '') then 
     begin 
       SaveButton.Enabled:=true; 
       BtnSaveToCard.Enabled:=true; 
       Delbtn.Enabled:=true; 
     end; 
   end; 
end; 

procedure TSDIAppForm.FileExit1Execute(Sender: TObject); 
begin 
  Close; 
end; 


function TSDIAppForm.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 TSDIAppForm.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 TSDIAppForm.LeftPad(S: string; Ch: Char; Len: Integer): string; 
 var 
   RestLen: Integer; 
 begin 
   Result  := S; 
   RestLen := Len - Length(s); 
   if RestLen < 1 then Exit; 
   Result := S + StringOfChar(Ch, RestLen); 
 end; 

 function TSDIAppForm.RightPad(S: string; Ch: Char; Len: Integer): string; 
 var 
   RestLen: Integer; 
 begin 
   Result  := S; 
   RestLen := Len - Length(s); 
   if RestLen < 1 then Exit; 
   Result := StringOfChar(Ch, RestLen) + S; 
 end; 

end.