Данные УФК в АС Бюджет

Все вопросы по АС Бюджет
Аватара пользователя
Val
зам. председателя совета директоров
зам. председателя совета директоров
Сообщения: 2029
Зарегистрирован: 09.06.2004 08:52
Откуда: Ейск
Контактная информация:

Данные УФК в АС Бюджет

Сообщение Val » 10.04.2009 13:09

только для теста
1. Получаем из ОФК файлы вида
....
9058d408.arj
9058d407.arj
9058d406.arj
....
2. Скрипт делает: разбирает архив первого уровня, второго уровня, файл pr6.xls конвертирует в текст с раделителем TAB, формирует SQL Insert и запускает его для базы АС Бюджет.
3. Пользователи формируют отчет в АС Бюджет.
Примеры приложены.

Таблица в базе:

Код: Выделить всё

SET NAMES WIN1251;
CREATE GENERATOR GEN_VAL_UFK_DATA_ID;

CREATE TABLE VAL_UFK_DATA (
    ID          ID NOT NULL /* ID = INTEGER NOT NULL */,
    REESTR      INTEGER,
    FK          NOTE255 /* NOTE255 = VARCHAR(255) */,
    ACC         ACCOUNT32 /* ACCOUNT32 = VARCHAR(20) */,
    ACCEPTDATE  NEWDATE /* NEWDATE = DOUBLE PRECISION */,
    DOC_NAME    NOTE255 /* NOTE255 = VARCHAR(255) */,
    DOC_BUF     NOTE255 COLLATE PXW_CYRL /* NOTE255 = VARCHAR(255) */,
    DOC_NUMBER  INTEGER,
    PLAT_INN    INN32 NOT NULL /* INN32 = DOUBLE PRECISION */,
    PLAT_KPP    VARCHAR(20) COLLATE PXW_CYRL,
    PLAT_NAME   NOTE255 /* NOTE255 = VARCHAR(255) */,
    ADM_INN     INN32 /* INN32 = DOUBLE PRECISION */,
    ADM_KPP     VARCHAR(20),
    OKATO       VARCHAR(11),
    TARGET      INTEGER DEFAULT 0 NOT NULL,
    KD          NOTE20 /* NOTE20 = VARCHAR(20) */,
    NOTE        NOTE255 /* NOTE255 = VARCHAR(255) */,
    DEBET       MONEY32 NOT NULL /* MONEY32 = NUMERIC(15,2) default 0 */,
    CREDIT      MONEY32 NOT NULL /* MONEY32 = NUMERIC(15,2) default 0 */,
    FILENAME    NOTE255 COLLATE PXW_CYRL /* NOTE255 = VARCHAR(255) */,
    LOADDATE    NEWDATE /* NEWDATE = DOUBLE PRECISION */
);
ALTER TABLE VAL_UFK_DATA ADD CONSTRAINT PK_VAL_UFK_DATA PRIMARY KEY (ID);
SET TERM ^ ;
/* Trigger: VAL_UFK_DATA_BI */
CREATE TRIGGER VAL_UFK_DATA_BI FOR VAL_UFK_DATA
ACTIVE BEFORE INSERT POSITION 0
as
begin
  if (new.id is null) then
    new.id = gen_id(gen_VAL_UFK_DATA_id,1);
end
^
SET TERM ; ^
/* Privileges of users */
GRANT SELECT, INSERT, UPDATE, DELETE ON VAL_UFK_DATA TO PUBLIC;

Скрипт не оптимизирован, многое еще не сделано.

Код: Выделить всё

#Скрипт для обработки файлов УФК и перегонке данных в базу АС Бюджет
# версия 1.00
# Val, 10042009, Ейский район.
system 'chcp 1251';
use strict;
use File::Basename;
use File::Path;
use Log::Log4perl;
   Log::Log4perl::init("c:/_code/log.conf");
   my $log = Log::Log4perl::get_logger("main");
use Win32::OLE;
use DBI;

my $DB_HOST = 'bigfinupmain';
my $DB_NAME_DB = 'D:\BudgetAx2009\Database\BUDGET2009.GDB';
my $DB_NAME_REG = 'D:\BudgetAx2009\Database\DBREG2009.GDB';
my $DB_CHARSET = 'WIN1251';
my $DB_USER = 'sysdba';
my $DB_PASSWORD = 'ХХХХХХХХХХХХХ';
my $dsn_db = "DBI:InterBase:database=$DB_NAME_DB;host=$DB_HOST;charset=$DB_CHARSET;ib_charset=win_1251";
my $dsn_reg = "DBI:InterBase:database=$DB_NAME_REG;host=$DB_HOST;charset=$DB_CHARSET;ib_charset=win_1251";
my $dbh;
my $sth;

my $arh_out = 'c:/temp/ufk_temp/';
my $arh_out2 = 'c:/temp/ufk_temp2/';
my $arh = '"c:/Program Files/7-Zip/7z.exe"';
my $arh_key = " x ";
my $arh_key2 = " e ";
my $arh_key_all = " -aoa -o";

sub openDB {
   my ($HOST_l,$DB_l,$USER_l,$PASSWORD_l,$CHARSET_l) = @_;
   my $DSN_l = "DBI:InterBase:database=$DB_l;host=$HOST_l;charset=$CHARSET_l;ib_charset=win_1251";
   $dbh = DBI->connect($DSN_l, $USER_l, $PASSWORD_l) or die "Can't connect to $DSN_l: $DBI::errstr";
}
#-------------------------------------------------------------------------------
sub closeDB {
   $dbh->disconnect();
}
# пишем в базу
#-------------------------------------------------------------------------------
sub writedb {
   my $str = shift;
   my $fname = shift;   
   my $s;
   $s="insert into val_ufk_data(REESTR,FK,ACC,ACCEPTDATE,DOC_NAME,DOC_BUF,DOC_NUMBER,PLAT_INN,PLAT_KPP,PLAT_NAME,ADM_INN,ADM_KPP,OKATO,TARGET,KD,NOTE,DEBET,CREDIT,FILENAME,LOADDATE) values (";
   foreach (@$str) { $s .= "'" . $_ . "',"; }
   $s = substr($s,0,length($s)-1) if (substr($s,-1) eq ",");
   my ($day, $month, $year) = (localtime)[3,4,5];
      $log->debug($fname . ":" . $day . ":" . $month . ":" . $year);
    $s .= ",'" . $fname . "','" . ($year + 1900) . ($month + 1) . ($day) . "'";
   $s .= ")";
   $log->debug("Запрос сформирован : ".$s);
   $dbh -> do($s);
   if ($dbh->err) { $log->logdie("SQL Error : ".$dbh->errstr) } else { $log->debug("Запрос выполнен без ошибок") };
}
# конвертируем XLS в CSV
#-------------------------------------------------------------------------------
sub xls_convert() {
   my $fname = shift;
   my $fname2 = $fname;
   $fname2 =~ s/xls/csv/g;
   $log->debug("Имя для выходного CSV : ".$fname2);
   my ($ex,$book,$sheet);   
 # use existing instance if Excel is already running
   eval {$ex = Win32::OLE->GetActiveObject('Excel.Application')};
   die "Excel not installed" if $@;
   unless (defined $ex) { $ex = Win32::OLE->new('Excel.Application', sub {$_[0]->Quit;}) or die "Oops, cannot start Excel"; }
   $ex->{DisplayAlerts} = 0;
   $book = $ex->Workbooks->Open( $fname );
   $sheet = $book->Worksheets(1);
   #print $sheet->Cells($i,$j)->{Value};
   $log->debug("пишем в файл ".$fname2);
   $book->SaveAs({Filename =>$fname2,FileFormat => '20'}) || $log->logdie("Ошибка Excel записи в CSV : " . $!);
   $ex->quit;
   return $fname2;
}
#-------------------------------------------------------------------------------
sub csv_convert() {
   my $fname_in = shift;
   my $fname_out = shift;
   $log->debug($fname_in . " => " . $fname_out);
   my (@a,@b);
   open(FF,$fname_in) || $log->logdie("не могу открыть фалй для чтения : $!");
   open(FF1,">".$fname_out) || $log->logdie("не могу открыть файл для записи : $!");
   @a = <FF>;
   close(FF);
   my @c;
   my %kl = ( reestr => "0", fk => "0", acc => "0", acceptdate => "0" );   
   chomp(@a);
   foreach (@a) {
      @c = split(/\t/,$_);
      
      $kl{reestr}=$c[8] if $c[0] eq "СВОДНЫЙ РЕЕСТР №";
      $kl{fk}=substr($c[3],0,255) if $c[0] eq "Орган Федерального казначейства";
      $kl{fk}=substr($kl{fk},1,255) if substr($kl{fk},0,1) eq "@";
      $kl{acc}=$c[13] if $c[12] eq "Номер счета";
      $kl{date}=$c[13] if $c[12] eq "Дата";
      $kl{date} =~ s/(\d\d).(\d\d).(\d\d\d\d)/$3$2$1/;
      
      if (($c[0] eq "П/п (дох. кл)/Обр поступл") or ($c[0] eq "Внутр. внебанк. док-т") or ($c[0] eq "Плат. поруч. (дох. кл.)"))  {
         $c[12] =~ s/\s//g;
         $c[13] =~ s/\s//g;
         $c[12] =~ s/,/\./g;
         $c[13] =~ s/,/\./g;
         if ($c[13] eq "") { $c[13]=0 };
         if ($c[12] eq "") { $c[12]=0 };
         if ($c[9] eq "") { $c[9]=0 };
         if ($c[6] eq "") { $c[6]=0 };
         if ($c[3] eq "") { $c[3]=0 };
         if ($c[2] eq "") { $c[2]=0 };
           
         my @c1 = ($kl{reestr},$kl{fk},$kl{acc},$kl{date},@c);
         foreach(@c1) { s/\'/\"/g; }
         writedb(\@c1,$fname_in);
         print FF1 "'$kl{reestr}'\t'$kl{fk}'\t'$kl{acc}'\t'$kl{date}'\t'" . join("'\t'",@c) .  "'\n";
      } 
   };
close(FF1);
}
#-------------------------------------------------------------------------------
openDB($DB_HOST,$DB_NAME_DB,$DB_USER,$DB_PASSWORD,$DB_CHARSET);
my $dir = shift @ARGV;
my @files = glob("$dir/*.arj");
# все файлы в каталоге
#-------------------------------------------------------------------------------
foreach (@files) {
      my $command = $arh.$arh_key.$_.$arh_key_all.$arh_out;
      my @result = `$command`;
      my @dirs_level1;
      my $files_level1 = $_;
      foreach (@result) {   if (/Extracting/) { /Extracting\s\s(.+)/; $log->debug($_); $dirs_level1[@dirs_level1] = $1 } }
      # все результаты первого уровня
      #-------------------------------------------------------------------------------
      foreach (@dirs_level1) {
         $command = $arh.$arh_key2.$arh_out.$_.$arh_key_all.$arh_out2;
         $log->debug($command);
         @result = `$command`;
         my $files_level2 = $_;
         #все результаты второго уровня
         #-------------------------------------------------------------------------------
         foreach (@result) {
            if (/Extracting/) { 
               /Extracting\s\s(.+)/;
               $log->debug($1);
               $files_level1 =~ tr/:\/\\\./_/;
               $files_level2 =~ tr/:\/\\\./_/;
               my $src = $arh_out2.$1;
               my $dst = $arh_out2.$files_level1."_".$files_level2."_".$1;
               $log->debug("переименовываем файл " . $src ." в " . $dst);
               rename($src,$dst) || $log->logdie("Ошибка переименования файла : ". $!);
               my $csv_file = &xls_convert($dst);
               $log->debug("удаляем xls ".$dst);
               unlink($dst);
               my $csv_file2 = $csv_file;
               $csv_file2 =~ s/\./_obr\./g;
               &csv_convert($csv_file,$csv_file2);
               $log->debug("удаляем csv ".$dst);
               unlink($csv_file);
               my($f1, $d1, $s1) = fileparse($csv_file2);
               $log->debug("перемещаем $csv_file2 в ".$dir."\\".$f1);
               rename($csv_file2,$dir."\\".$f1) || $log->logdie("Ошибка переименования файла : ". $!);
            }       
         }
         #-------------------------------------------------------------------------------   
      }
      #-------------------------------------------------------------------------------
      $log->debug("удаляем каталог ".$arh_out);
        rmtree($arh_out);
       $log->debug("удаляем каталог ".$arh_out2);
      rmtree($arh_out2);
            
}
#-------------------------------------------------------------------------------
closeDB();
У вас нет необходимых прав для просмотра вложений в этом сообщении.

Аватара пользователя
Val
зам. председателя совета директоров
зам. председателя совета директоров
Сообщения: 2029
Зарегистрирован: 09.06.2004 08:52
Откуда: Ейск
Контактная информация:

Re: Данные УФК в АС Бюджет

Сообщение Val » 08.09.2009 10:59

Код: Выделить всё

#Скрипт для обработки файлов УФК и перегонке данных в базу АС Бюджет
# версия 1.00
# Val, 10042009, Ейский район.
# версия 1.01
# обработка результата работы архиватора изменена (добалено .ARJ)
# Val, 08092009, Ейский район.

system 'chcp 1251';
use strict;
use File::Basename;
use File::Path;
use Log::Log4perl;
   Log::Log4perl::init("c:/_code/log.conf");
   my $log = Log::Log4perl::get_logger("main");
use Win32::OLE;
use DBI;

my $DB_HOST = 'bigfinupmain';
my $DB_NAME_DB = 'D:\BudgetAx2009\Database\BUDGET2009.GDB';
my $DB_NAME_REG = 'D:\BudgetAx2009\Database\DBREG2009.GDB';
my $DB_CHARSET = 'WIN1251';
my $DB_USER = 'sysdba';
my $DB_PASSWORD = 'nastik';
my $dsn_db = "DBI:InterBase:database=$DB_NAME_DB;host=$DB_HOST;charset=$DB_CHARSET;ib_charset=win_1251";
my $dsn_reg = "DBI:InterBase:database=$DB_NAME_REG;host=$DB_HOST;charset=$DB_CHARSET;ib_charset=win_1251";
my $dbh;
my $sth;

my $arh_out = 'c:/temp/ufk_temp/';
my $arh_out2 = 'c:/temp/ufk_temp2/';
my $arh = '"c:/Program Files/7-Zip/7z.exe"';
my $arh_key = " x ";
my $arh_key2 = " e ";
my $arh_key_all = " -aoa -o";

sub openDB {
   my ($HOST_l,$DB_l,$USER_l,$PASSWORD_l,$CHARSET_l) = @_;
   my $DSN_l = "DBI:InterBase:database=$DB_l;host=$HOST_l;charset=$CHARSET_l;ib_charset=win_1251";
   $dbh = DBI->connect($DSN_l, $USER_l, $PASSWORD_l) or die "Can't connect to $DSN_l: $DBI::errstr";
}
#-------------------------------------------------------------------------------
sub closeDB {
   $dbh->disconnect();
}
# пишем в базу
#-------------------------------------------------------------------------------
sub writedb {
   my $str = shift;
   my $fname = shift;
   my $s;
   $s="insert into val_ufk_data(REESTR,FK,ACC,ACCEPTDATE,DOC_NAME,DOC_BUF,DOC_NUMBER,PLAT_INN,PLAT_KPP,PLAT_NAME,ADM_INN,ADM_KPP,OKATO,TARGET,KD,NOTE,DEBET,CREDIT,FILENAME,LOADDATE) values (";
   foreach (@$str) { $s .= "'" . $_ . "',"; }
   $s = substr($s,0,length($s)-1) if (substr($s,-1) eq ",");
   my ($day, $month, $year) = (localtime)[3,4,5];
      $log->debug($fname . ":" . $day . ":" . $month . ":" . $year);
    $s .= ",'" . $fname . "','" . ($year + 1900) . ($month + 1) . ($day) . "'";
   $s .= ")";
   #$log->debug("Запрос сформирован : ".$s);
   $dbh -> do($s);
   #if ($dbh->err) { $log->logdie("SQL Error : ".$dbh->errstr) } else { $log->debug("Запрос выполнен без ошибок") };
   if ($dbh->err) { $log->logdie("SQL Error : ".$dbh->errstr) };
}
# конвертируем XLS в CSV
#-------------------------------------------------------------------------------
sub xls_convert() {
   my $fname = shift;
   my $fname2 = $fname;
   $fname2 =~ s/xls/csv/g;
   $log->debug("Имя для выходного CSV : ".$fname2);
   my ($ex,$book,$sheet);
 # use existing instance if Excel is already running
   eval {$ex = Win32::OLE->GetActiveObject('Excel.Application')};
   die "Excel not installed" if $@;
   unless (defined $ex) { $ex = Win32::OLE->new('Excel.Application', sub {$_[0]->Quit;}) or die "Oops, cannot start Excel"; }
   $ex->{DisplayAlerts} = 0;
   $book = $ex->Workbooks->Open( $fname );
   $sheet = $book->Worksheets(1);
   #print $sheet->Cells($i,$j)->{Value};
   $log->debug("пишем в файл ".$fname2);
   $book->SaveAs({Filename =>$fname2,FileFormat => '20'}) || $log->logdie("Ошибка Excel записи в CSV : " . $!);
   $ex->quit;
   return $fname2;
}
#-------------------------------------------------------------------------------
sub csv_convert() {
   my $fname_in = shift;
   my $fname_out = shift;
   $log->debug($fname_in . " => " . $fname_out);
   my (@a,@b);
   open(FF,$fname_in) || $log->logdie("не могу открыть фалй для чтения : $!");
   open(FF1,">".$fname_out) || $log->logdie("не могу открыть файл для записи : $!");
   @a = <FF>;
   close(FF);
   my @c;
   my %kl = ( reestr => "0", fk => "0", acc => "0", acceptdate => "0" );
   chomp(@a);
   foreach (@a) {
      @c = split(/\t/,$_);

      $kl{reestr}=$c[8] if $c[0] eq "СВОДНЫЙ РЕЕСТР №";
      $kl{fk}=substr($c[3],0,255) if $c[0] eq "Орган Федерального казначейства";
      $kl{fk}=substr($kl{fk},1,255) if substr($kl{fk},0,1) eq "@";
      $kl{acc}=$c[13] if $c[12] eq "Номер счета";
      $kl{date}=$c[13] if $c[12] eq "Дата";
      $kl{date} =~ s/(\d\d).(\d\d).(\d\d\d\d)/$3$2$1/;

      if (($c[0] eq "П/п (дох. кл)/Обр поступл") or ($c[0] eq "Внутр. внебанк. док-т") or ($c[0] eq "Плат. поруч. (дох. кл.)"))  {
         $c[12] =~ s/\s//g;
         $c[13] =~ s/\s//g;
         $c[12] =~ s/,/\./g;
         $c[13] =~ s/,/\./g;
         $c[3] =~ tr/0-9//cd;
         if ($c[13] eq "") { $c[13]=0 };
         if ($c[12] eq "") { $c[12]=0 };
         if ($c[9] eq "") { $c[9]=0 };
         if ($c[6] eq "") { $c[6]=0 };
         if ($c[3] eq "") { $c[3]=0 };
         if ($c[2] eq "") { $c[2]=0 };

         my @c1 = ($kl{reestr},$kl{fk},$kl{acc},$kl{date},@c);
         foreach(@c1) { s/\'/\"/g; }
         writedb(\@c1,$fname_in);
         print FF1 "'$kl{reestr}'\t'$kl{fk}'\t'$kl{acc}'\t'$kl{date}'\t'" . join("'\t'",@c) .  "'\n";
      }
   };
close(FF1);
}
#-------------------------------------------------------------------------------
openDB($DB_HOST,$DB_NAME_DB,$DB_USER,$DB_PASSWORD,$DB_CHARSET);
my $dir = shift @ARGV;
my @files = glob("$dir/*.rar");
# все файлы в каталоге
#-------------------------------------------------------------------------------
foreach (@files) {
      my $command = $arh.$arh_key.$_.$arh_key_all.$arh_out;
      my @result = `$command`;
      $log -> debug("RESULT! : ");   
      $log -> debug(@result);
      my @dirs_level1;
      my $files_level1 = $_;
      foreach (@result) {   if (/Extracting/) { /Extracting\s\s(.+).ARJ/; $log->debug($_); $dirs_level1[@dirs_level1] = $1.".ARJ" } }
      # все результаты первого уровня
      #-------------------------------------------------------------------------------
      foreach (@dirs_level1) {
         $command = $arh.$arh_key2.$arh_out.$_.$arh_key_all.$arh_out2;
         $log->debug($command);
         @result = `$command`;
         my $files_level2 = $_;
         #все результаты второго уровня
         #-------------------------------------------------------------------------------
         foreach (@result) {
            if (/Extracting/) {
               /Extracting\s\s(.+)/;
               $log->debug($1);
               $files_level1 =~ tr/:\/\\\./_/;
               $files_level2 =~ tr/:\/\\\./_/;
               my $src = $arh_out2.$1;
               my $dst = $arh_out2.$files_level1."_".$files_level2."_".$1;
               $log->debug("переименовываем файл " . $src ." в " . $dst);
               rename($src,$dst) || $log->logdie("Ошибка переименования файла : ". $!);
               my $csv_file = &xls_convert($dst);
               $log->debug("удаляем xls ".$dst);
               unlink($dst);
               my $csv_file2 = $csv_file;
               $csv_file2 =~ s/\./_obr\./g;
               &csv_convert($csv_file,$csv_file2);
               $log->debug("удаляем csv ".$dst);
               unlink($csv_file);
               my($f1, $d1, $s1) = fileparse($csv_file2);
               $log->debug("перемещаем $csv_file2 в ".$dir."\\".$f1);
               rename($csv_file2,$dir."\\".$f1) || $log->logdie("Ошибка переименования файла : ". $!);
            }
         }
         #-------------------------------------------------------------------------------
      }
      #-------------------------------------------------------------------------------
      $log->debug("удаляем каталог ".$arh_out);
        rmtree($arh_out);
       $log->debug("удаляем каталог ".$arh_out2);
      rmtree($arh_out2);

}
#-------------------------------------------------------------------------------
closeDB();


Вернуться в «АС Бюджет»

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и 7 гостей

cron