You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 

395 lines
12 KiB

unit ufrmRemessa;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, System.DateUtils, System.RegularExpressions,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, umstMaster, Vcl.ComCtrls, Data.DB,
ZAbstractRODataset, ZDataset, Vcl.DBCtrls, Vcl.StdCtrls, Vcl.Buttons,
Vcl.Grids, Vcl.DBGrids;
type
TfrmRemessa = class(TmstMaster)
dtsDevedores: TDataSource;
roqryDevedores: TZReadOnlyQuery;
gb_devedores: TGroupBox;
cbx_todosdevedores: TCheckBox;
gb_dtvenc: TGroupBox;
dtp_vencini: TDateTimePicker;
Label14: TLabel;
dtp_vencfim: TDateTimePicker;
gb_emissao: TGroupBox;
Label1: TLabel;
dtp_emissaoini: TDateTimePicker;
dtp_emissaofim: TDateTimePicker;
gb_progress: TGroupBox;
pb_remessa: TProgressBar;
Button1: TButton;
sv_dlg: TSaveDialog;
gb_pesquisa: TGroupBox;
edt_pesquisa: TEdit;
SpeedButton1: TSpeedButton;
dbgrd_pesquisa: TDBGrid;
roqryDevedoresID_DEVEDOR: TIntegerField;
roqryDevedoresTX_NOME: TWideStringField;
roqryDevedoresTX_DOCUMENTO: TWideStringField;
lbl_progresso: TLabel;
gb_conta: TGroupBox;
roqryRemessa: TZReadOnlyQuery;
gb_credor: TGroupBox;
dblcb_conta: TDBLookupComboBox;
dblcb_credor: TDBLookupComboBox;
cb_emissao: TCheckBox;
cb_venc: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure cbx_todosdevedoresClick(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
procedure DecNrRemessa;
function ExtractNumbers(const s: string): string;
{ Private declarations }
public
{ Public declarations }
end;
var
frmRemessa: TfrmRemessa;
implementation
{$R *.dfm}
uses udtmSystem;
procedure TfrmRemessa.Button1Click(Sender: TObject);
var
year, month, day, count, qtd_lotes, qtd_regs, qtd_contas, msg1, msg2: string;
arquivo: TextFile;
i: integer;
qtd_tit: string;
vtit_total: string;
begin
inherited;
lbl_progresso.caption := 'Gerando o arquivo de remessa...';
lbl_progresso.Refresh;
if dblcb_conta.KeyValue = Null then
begin
MessageDlg('Por favor selecione uma conta.', mtWarning, [mbOK], 0);
exit;
end;
if dblcb_credor.KeyValue = Null then
begin
MessageDlg('Por favor selecione um credor.', mtWarning, [mbOK], 0);
exit;
end;
with dtmSystem do
// arruma data e id da remessa para usar no arquivo e nos títulos
begin
tblContas.Refresh;
tblEmpresa.Refresh;
if tblEmpresaCD_BENEFICIARIO.IsNull then
begin
MessageDlg
('Código de beneficiário não cadastrado na Empresa possuidora do software.'
+ ' Não é possível gerar aquivo de remessa.', mtWarning, [mbOK], 0);
exit;
end;
if tblContasDT_REMESSA.IsNull then
begin
tblContas.Edit;
tblContasDT_REMESSA.AsDateTime := Date;
tblContas.Post;
end;
if tblContasDT_REMESSA.AsDateTime <> Date then
begin
tblContas.Edit;
tblContasDT_REMESSA.AsDateTime := Date;
tblContasNR_REMESSA.AsInteger := 1;
tblContas.Post;
end
else
begin
tblContas.Edit;
tblContasNR_REMESSA.AsInteger := tblContasNR_REMESSA.AsInteger + 1;
tblContas.Post;
end;
end;
year := inttostr(YearOf(Date));
month := inttostr(Monthof(Date)).PadLeft(2, '0');
day := inttostr(Dayof(Date)).PadLeft(2, '0');
count := dtmSystem.tblContasNR_REMESSA.AsString.PadLeft(5, '0');
sv_dlg.FileName := 'CLI_ CRB_' + dtmSystem.tblEmpresaCD_BENEFICIARIO.AsString
+ year + month + day + '_CNAB240REM.' + count;
if not sv_dlg.Execute then
begin
DecNrRemessa;
exit;
end;
Screen.Cursor := crHourGlass;
// constrói a lista de devedores a serem enviados os boletos
if cbx_todosdevedores.Checked then
begin
end
else
begin
if roqryDevedores.RecordCount = 0 then
begin
MessageDlg('Opção de todos os devedores não se encontra marcada e' +
' não há devedores encontrados na pesquisa.' +
' Por favor verifique o filtro para remessa', mtWarning, [mbOK], 0);
DecNrRemessa;
exit;
end
else
begin
if MessageDlg('Por favor, verifique que o devedor certo' +
' está selecionado na caixa de pesquisa.' + ' Deseja continuar?',
mtWarning, [mbYes, mbCancel], 0) = mrYes then
begin
with roqryRemessa.SQL do
begin
Clear;
Add('select * from chg_titulos where');
Add('id_empresa = ' + string(dblcb_credor.KeyValue));
Add('and');
Add('id_devedor = ' + roqryDevedoresID_DEVEDOR.AsString);
end;
roqryRemessa.Open;
roqryRemessa.RecordCount;
end
else
begin
DecNrRemessa;
exit;
end;
end;
end;
assignfile(arquivo, sv_dlg.FileName);
rewrite(arquivo);
// CNAB 240 BANPARA
// HEADER do arquivo
// nums a direita com zeros a esquerda
// texto a esquerda com vazios a direita
writeln(arquivo, // arquivo
'037', // Código do Banco na Compensação
'0000', // Lote de Serviço - 0000 para header
'0', // Tipo de Registro
''.PadRight(9, ' '), // Uso Exclusivo FEBRABAN / CNAB
'2', // Tipo de Inscrição da Empresa
'04913711000108', // Número de Inscrição da Empresa
dtmSystem.tblEmpresaCD_BENEFICIARIO.AsString.PadRight(20, ' '),
// Código do Convênio no Banco
dtmSystem.tblContasCD_AGENCIA.AsString.PadLeft(5, '0'),
// Agência Mantenedora da Conta
dtmSystem.tblContasCD_AGENCIA_DV.AsString.PadLeft(1, '0'),
// Dígito Verificador da Agência
dtmSystem.tblContasCD_CONTA.AsString.PadLeft(12, '0'),
// Número da Conta Corrente
dtmSystem.tblContasCD_CONTA_DV.AsString.PadLeft(1, '0'),
// Dígito Verificador da Conta
'0', // Dígito Verificador da Ag/Conta - detalhe extra, talvez seja vazio
'Banco do Estado do Para S/A'.PadRight(30, ' '), // Nome da Empresa
'Banco do Estado do Para S/A'.PadRight(30, ' '), // Nome do Banco
''.PadRight(10, ' '), // Uso Exclusivo FEBRABAN / CNAB
'1', // Código Remessa / Retorno
day, month, year, // Data de Geração do Arquivo
HourOf(Now), MinuteOf(Now), SecondOf(Now), // // Hora de Geração do Arquivo
count.PadLeft(6, '0'), // Número Seqüencial do Arquivo
'101', // No da Versão do Layout do Arquivo
'00000', // Densidade de Gravação do Arquivo
''.PadRight(69, ' ')
// Para Uso Reservado do Banco [20] - Para Uso Reservado da Empresa [20] - Uso Exclusivo FEBRABAN / CNAB [29]
);
// HEADER de lote
writeln(arquivo, // arquivo
'037', // Código do Banco na Compensação
inttostr(i).PadLeft(4, '0'), // Lote de Serviço
'1', // Tipo de Registro
'R', // Tipo de Operação
'01', // Tipo de Serviço
''.PadRight(2, ' '), // Uso Exclusivo FEBRABAN/CNAB
'060', // Nº da Versão do Layout do Lote
''.PadRight(1, ' '), // Uso Exclusivo FEBRABAN/CNAB
'2', // Tipo de Inscrição da Empresa
'04913711000108', // Número de Inscrição da Empresa
dtmSystem.tblEmpresaCD_BENEFICIARIO.AsString.PadRight(20, ' '),
// Código do Convênio no Banco
dtmSystem.tblContasCD_AGENCIA.AsString.PadLeft(5, '0'),
// Agência Mantenedora da Conta
dtmSystem.tblContasCD_AGENCIA_DV.AsString.PadLeft(1, '0'),
// Dígito Verificador da Agência
dtmSystem.tblContasCD_CONTA.AsString.PadLeft(12, '0'),
// Número da Conta Corrente
dtmSystem.tblContasCD_CONTA_DV.AsString.PadLeft(1, '0'),
// Dígito Verificador da Conta
'0', // Dígito Verificador da Ag/Conta - detalhe extra, talvez seja vazio
msg1.PadRight(40, ' '), // Mensagem 1
msg2.PadRight(40, ' '), // Mensagem 2
dtmSystem.tblContasNR_REMESSA.AsString.PadLeft(8, '0'),
// Número Remessa/Retorno
day, month, year, // Data de Gravação Remessa/Retorno
'00000000', // Data do Crédito
''.PadRight(33, ' ') // Uso Exclusivo FEBRABAN/CNAB
);
// TRAILER do lote
qtd_lotes := '1';
qtd_regs := '1'; // placeholders
qtd_contas := '1';
qtd_tit := '1';
vtit_total := '1';
writeln(arquivo, // arquivo
'037', // Código do Banco na Compensação
qtd_lotes.PadLeft(6, '0'), // Lote de Serviço
'5', // Tipo de Registro
''.PadRight(9, ' '), // Uso Exclusivo FEBRABAN/CNAB
qtd_lotes.PadLeft(6, '0'),
// Quantidade de Registros no Lote ** Olhar campo G003
qtd_tit.PadLeft(6, '0'), // Quantidade de Títulos em Cobrança Simples
vtit_total.PadLeft(17, '0'), // Valor Total dos Títulos em Carteiras Simples
qtd_tit.PadLeft(6, '0'), // Quantidade de Títulos em Cobrança Vinculada
vtit_total.PadLeft(17, '0'),
// Valor Total dos Títulos em Carteiras Vinculada
qtd_tit.PadLeft(6, '0'), // Quantidade de Títulos em Cobrança Caucionada
vtit_total.PadLeft(17, '0'),
// Quantidade de Títulos em Carteiras Caucionada
qtd_tit.PadLeft(6, '0'), // Quantidade de Títulos em Cobrança Descontada
vtit_total.PadLeft(17, '0'),
// Valor Total dos Títulos em Carteiras Descontada
''.PadRight(8, ' '), // Número do Aviso de Lançamento
''.PadRight(117, ' ') // Uso Exclusivo FEBRABAN/CNAB
);
// TRAILER do arquivo
writeln(arquivo, // arquivo
'037', // Código do Banco na Compensação
'9999', // Lote de Serviço
'9', // Tipo de Registro
''.PadRight(9, ' '), // Uso Exclusivo FEBRABAN/CNAB
qtd_lotes.PadLeft(6, '0'), // Quantidade de Lotes do Arquivo
qtd_regs.PadLeft(6, '0'), // Quantidade de Registros do Arquivo
qtd_contas.PadLeft(6, '0'), // Qtde de Contas p/ Conc. (Lotes)
''.PadRight(205, ' ') // Uso Exclusivo FEBRABAN/CNAB
);
CloseFile(arquivo);
lbl_progresso.caption := 'Fim da criação do arquivo de remessa.';
lbl_progresso.Refresh;
Screen.Cursor := crDefault;
end;
procedure TfrmRemessa.cbx_todosdevedoresClick(Sender: TObject);
begin
inherited;
gb_pesquisa.Enabled := not(cbx_todosdevedores.Checked);
end;
function TfrmRemessa.ExtractNumbers(const s: string): string;
var
Regex: TRegEx;
match: TMatch;
matches: TMatchCollection;
i: integer;
res: string;
begin
res := '';
i := 0;
Regex := TRegEx.Create('\d+');
matches := Regex.matches(s);
if matches.count > 0 then
begin
for match in matches do
begin
res := res + match.Value;
end;
end;
Result := res;
end;
procedure TfrmRemessa.FormCreate(Sender: TObject);
begin
inherited;
roqryDevedores.Open;
with dtmSystem do
begin
if not tblContas.Active then
begin
tblContas.Open;
end
else
begin
tblContas.Refresh;
end;
if not tblEmpresa.Active then
begin
tblEmpresa.Open;
end
else
begin
tblEmpresa.Refresh;
end;
if not tblCHGEmpresa.Active then
begin
tblCHGEmpresa.Open;
end
else
begin
tblCHGEmpresa.Refresh;
end;
end;
end;
procedure TfrmRemessa.DecNrRemessa;
begin
dtmSystem.tblContas.Edit;
dtmSystem.tblContasNR_REMESSA.AsInteger :=
dtmSystem.tblContasNR_REMESSA.AsInteger - 1;
dtmSystem.tblContas.Post;
end;
procedure TfrmRemessa.SpeedButton1Click(Sender: TObject);
var
str_query: string;
SQL: string;
begin
inherited;
if edt_pesquisa.Text <> '' then
begin
SQL := 'select id_devedor, tx_nome, case when TP_CLIENTE = ' +
QuotedStr('F') + ' then CD_CPF when TP_CLIENTE = ' + QuotedStr('J') +
' then CD_CNPJ end as TX_DOCUMENTO from chg_devedores ';
str_query := 'where upper(tx_nome COLLATE WIN_PTBR) like ' +
QuotedStr('%' + Ansiuppercase(stringreplace(edt_pesquisa.Text, ' ', '%',
[rfReplaceAll])) + '%') + ' or cd_cpf like ' +
QuotedStr('%' + edt_pesquisa.Text + '%') + ' or cd_cnpj like ' +
QuotedStr('%' + edt_pesquisa.Text + '%');
roqryDevedores.SQL.Text := SQL + str_query;
roqryDevedores.Open;
end;
end;
end.