Rotina esgotando a meméria física

Delphi

30/09/2008

Olá,

estou dando manutenção num sistema de doações com Delphi 2007 e Firebird 2.0.3,
e recentemente me foi pedido para q eu elaborasse uma maneira de gerar parcelas automaticamente para os doadores até um determinado mês de um determinado ano, bom, até ai tudo bem, pois essa rotina já existe só q é executada pelas operadoras, quando necessário, então eu aproveitei essa rotina para fazer o q me pediram, só q a coisa não deu muito certo, quando mando executar, começa tudo bem, mas de repente ´unable to allocate memory from operating system.´, quando fui ver no Gerenciador de Tarefas do windows, um baita susto, o Firebird consumindo quase 1 GB de memória, assim tb como a aplicação, essa rotina é chamada em um laço para cada um dos registros de uma tabela(ClientDataSet):

function Tdm.F_Insere_Parcelas(V_Con: TSQLConnection; P_Id_Doa,
P_Qtde_Parc: Integer; P_Mes_Inicial, ResCom, Frequencia: String): ShortString;
Var
Q_Apaga_Doacoes, Q_Obtem_Doador, Q_Insere_Doacao:TSQLQuery;
V_Dia_Venc, V_Cont, Contador, Freq:Integer;
V_Venc_Inicial,V_Venc_Aux:TDateTime;
V_Dt:String;

Begin
// showmessage(inttostr(P_Id_Doa)+´ ´+inttostr(P_Qtde_parc)+´ ´+P_Mes_Inicial+´ ´+Rescom);
// showmessage(inttostr(P_Qtde_Parc)+´,´+P_Mes_inicial+´,´+Frequencia);
Q_Insere_Doacao := TSQLQuery.Create(nil);
Q_Insere_Doacao.SQLConnection := V_Con;

Q_Apaga_Doacoes := TSQLQuery.Create(nil);
Q_Apaga_Doacoes.SQLConnection := V_Con;

Q_Obtem_Doador := TSQLQuery.Create(nil);
Q_Obtem_Doador.SQLConnection := V_Con;
Q_Obtem_Doador.Close;
Q_Obtem_Doador.SQL.Clear;
if (ResCom = ´C´) then
begin
Q_Obtem_Doador.SQL.Add(´SELECT Tab_Doadores.Doa_Id, Tab_Doadores.Doa_Dia_Recebimento, Tab_Doadores.Doa_Valor_Parcela, Tab_Doadores.Doa_Operadora, Tab_Bairros.Bai_Fun_Id´);
Q_Obtem_Doador.SQL.Add(´FROM Tab_Bairros INNER JOIN Tab_Doadores ON Tab_Bairros.Bai_Id = Tab_Doadores.Doa_Bairro_Com´);
Q_Obtem_Doador.SQL.Add(´WHERE Tab_Doadores.Doa_Id = ´ + IntToStr(P_Id_Doa));
Q_Obtem_Doador.SQL.Add(´AND Tab_Bairros.Bai_Fun_Id Is Not Null´);
Q_Obtem_Doador.SQL.Add(´AND Tab_Doadores.Doa_Status = ´+asp+´A´+asp);
end
else
begin
Q_Obtem_Doador.SQL.Add(´SELECT Tab_Doadores.Doa_Id, Tab_Doadores.Doa_Dia_Recebimento, Tab_Doadores.Doa_Valor_Parcela, Tab_Doadores.Doa_Operadora, Tab_Bairros.Bai_Fun_Id´);
Q_Obtem_Doador.SQL.Add(´FROM Tab_Bairros INNER JOIN Tab_Doadores ON Tab_Bairros.Bai_Id = Tab_Doadores.Doa_Bairro´);
Q_Obtem_Doador.SQL.Add(´WHERE Tab_Doadores.Doa_Id = ´ + IntToStr(P_Id_Doa));
Q_Obtem_Doador.SQL.Add(´AND Tab_Bairros.Bai_Fun_Id Is Not Null´);
Q_Obtem_Doador.SQL.Add(´AND Tab_Doadores.Doa_Status = ´+asp+´A´+asp);
end;

Q_Obtem_Doador.Open;

If Q_Obtem_Doador.eof then
Begin
F_Insere_Parcelas2 := ´0´;
// showmessage(´Retornou 0´);
End
Else
Begin
V_Dia_Venc := Q_Obtem_Doador.FieldByName(´Doa_Dia_Recebimento´).AsInteger;
// showmessage(inttostr(V_Dia_Venc));
V_Dt := IntToStr(V_Dia_Venc) + ´/´ + F_Replica(copy(P_Mes_Inicial,1,2),2,´0´) + ´/´ + copy(P_Mes_Inicial,4,4);
While F_Data_Valida(V_Dt) = False do
Begin
V_Dia_Venc := V_Dia_Venc - 1;
V_Dt := IntToStr(V_Dia_Venc) + ´/´ + F_Replica(copy(P_Mes_Inicial,1,2),2,´0´) + ´/´ + copy(P_Mes_Inicial,4,4);
End;

V_Venc_Inicial := StrToDate(V_Dt);

// For V_Cont := 0 to P_Qtde_Parc -1 do
if Frequencia = ´M´ then
V_Cont:=1
else
if Frequencia = ´B´ then
V_Cont:=2
else
if Frequencia = ´T´ then
V_Cont:=3
else
if Frequencia = ´Q´ then
V_Cont:=4
else
if Frequencia = ´S´ then
V_Cont:=6
else
if Frequencia = ´A´ then
V_Cont:=12;
Contador := 0;
Freq := 0;
while Freq <= (P_Qtde_Parc - 1) do
Begin
V_Venc_Aux := IncMonth(V_Venc_Inicial,Contador);
if (F_Obtem_Dia_Util(V_Con,datetostr(V_Venc_Aux)) = ´N´) and (DayOfTheMonth(V_Venc_Aux) = 1) then
V_Venc_Aux := IncDay(V_Venc_Aux,1)
else
if F_Obtem_Dia_Util(V_Con,datetostr(V_Venc_Aux)) = ´N´ then
V_Venc_Aux := IncDay(V_Venc_Aux,-1)
else
if (DayOfTheMonth(V_Venc_Aux) = 1) and (DayOfWeek(V_Venc_Aux) = 1) then
V_Venc_Aux := IncDay(V_Venc_Aux,1)
else
//Se for no domingo a data será decrementada em uma dia(Sábado)
If DayOfWeek(V_Venc_Aux) = 1 then V_Venc_Aux := IncDay(V_Venc_Aux,-1);
// If DayOfTheMonth(V_Venc_Aux) = 1 then V_Venc_Aux := IncDay(V_Venc_Aux,-1);

If Not F_Existe_Doacao(V_Con,P_Id_Doa,V_Venc_Aux) then
Begin
Q_Apaga_Doacoes.Close;
Q_Apaga_Doacoes.SQL.Clear;
Q_Apaga_Doacoes.SQL.Add(´DELETE FROM Tab_Doacoes´);
Q_Apaga_Doacoes.SQL.Add(´WHERE Tab_Doacoes.Doc_Doa_Id=´ + IntToStr(P_Id_Doa));
Q_Apaga_Doacoes.SQL.Add(´AND Tab_Doacoes.Doc_Status_Doacao < 4´);
Q_Apaga_Doacoes.SQL.Add(´AND Tab_Doacoes.Doc_Status_Impressao = 6´);
Q_Apaga_Doacoes.SQL.Add(´AND Extract(year from Tab_Doacoes.Doc_Data_Operacao)= ´ + FormatDateTime(´yyyy´, V_Venc_Aux));
Q_Apaga_Doacoes.SQL.Add(´AND Extract(month from Tab_Doacoes.Doc_Data_Operacao)= ´ + FormatDateTime(´mm´, V_Venc_Aux));
Q_Apaga_Doacoes.ExecSQL;

Q_Insere_Doacao.Close;
Q_Insere_Doacao.SQL.Clear;
Q_Insere_Doacao.SQL.Add(´INSERT INTO Tab_Doacoes´);
Q_Insere_Doacao.SQL.Add(´(Doc_Doa_Id,Doc_Func_Operadora,Doc_Func_Mensageiro,Doc_Data_Operacao,Doc_Valor)´);
Q_Insere_Doacao.SQL.Add(´VALUES´);
Q_Insere_Doacao.SQL.Add(´(´ + asp + IntToStr(P_Id_Doa) + asp +´,´);
Q_Insere_Doacao.SQL.Add(´´ + asp + Q_Obtem_Doador.FieldByName(´Doa_Operadora´).AsString + asp +´,´);
Q_Insere_Doacao.SQL.Add(´´ + asp + Q_Obtem_Doador.FieldByName(´Bai_Fun_Id´).AsString + asp + ´,´);
Q_Insere_Doacao.SQL.Add(asp + FormatDateTime(´mm/dd/yyyy´,V_Venc_Aux) + asp + ´,´);
Q_Insere_Doacao.SQL.Add(´´ + asp + Q_Obtem_Doador.FieldByName(´Doa_Valor_Parcela´).AsString + asp + ´)´);
Q_Insere_Doacao.ExecSQL;
End;
Contador := Contador + V_Cont;
Freq := Freq + 1;
End;
F_Insere_Parcelas2 := ´1´;
// showmessage(´Retornou 1´);
End;
Freeandnil(Q_Insere_Doacao);
Freeandnil(Q_Apaga_Doacoes);
Freeandnil(Q_Obtem_Doador);

end;


Fajo

Fajo

Curtidas 0

Respostas

Emerson Nascimento

Emerson Nascimento

30/09/2008

fiz pequenas alterações no seu código, porém não alterei a lógica.
percebi algo confuso...

no trecho que você avalia a se é dia útil, se é início de mês, pra mim está confuso.
if DayOf(V_Venc_Aux) = 1 then
  V_Venc_Aux := V_Venc_Aux + 1
else
  V_Venc_Aux := V_Venc_Aux - 1;

pra mim está estranho. por exemplo: imagine que a data resultante seja dia 1o.de algum mês.
o código acima verifica que é o promeiro dia e soma 1. a data de vencimento passa para o dia 2, o que dá a entender que o vencimento não pode cair no 1o. dia do mês, por isso o if.
porém o [i:1a11b5c22f]else[/i:1a11b5c22f] desmente isso. ou seja, se o vencimento caiu no dia 2, o else devolve para dia 1o, pois subtrai 1 dia do vencimento.
sem contar que, aparentemente, [i:1a11b5c22f]DayOfWeek(V_Venc_Aux) = 1[/i:1a11b5c22f] e [i:1a11b5c22f]diautil = ´N´[/i:1a11b5c22f] são a mesma coisa.

outra coisa que me causou estranheza foi a avaliação sobre já existir doações/parcelas gravadas para aquele doador naquele vencimento (talvez verificando somente mes/ano).
o código nos indica que, se NÃO houver doações, ainda assim ele apaga as doações - que já não existem - e depois inclue a doação recém calculada.

talvez eu tenha entendido errado...
function Tdm.F_Insere_Parcelas(V_Con: TSQLConnection; P_Id_Doa,
P_Qtde_Parc: Integer; P_Mes_Inicial, ResCom, Frequencia: String): ShortString;
Var
  Q_Apaga_Doacoes, Q_Obtem_Doador, Q_Insere_Doacao:TSQLQuery;
  V_Dia_Venc, V_Cont, Freq: Integer;
  V_Venc_Inicial, V_Venc_Aux, V_Data:TDateTime;
  V_Dt:String;
  diautil: string[1]; // ou char, o que for mais adequado
Begin
//  showmessage(inttostr(P_Id_Doa)+´ ´+inttostr(P_Qtde_parc)+´ ´+P_Mes_Inicial+´ ´+Rescom);
//  showmessage(inttostr(P_Qtde_Parc)+´,´+P_Mes_inicial+´,´+Frequencia);
  Q_Insere_Doacao := TSQLQuery.Create(nil);
  Q_Insere_Doacao.SQLConnection := V_Con;

  Q_Apaga_Doacoes := TSQLQuery.Create(nil);
  Q_Apaga_Doacoes.SQLConnection := V_Con;

  Q_Obtem_Doador := TSQLQuery.Create(nil);
  Q_Obtem_Doador.SQLConnection := V_Con;

  Q_Obtem_Doador.SQL.Add(´SELECT Tab_Doadores.Doa_Id, Tab_Doadores.Doa_Dia_Recebimento, Tab_Doadores.Doa_Valor_Parcela, Tab_Doadores.Doa_Operadora, Tab_Bairros.Bai_Fun_Id´);

  if (ResCom = ´C´) then
    Q_Obtem_Doador.SQL.Add(´FROM Tab_Bairros INNER JOIN Tab_Doadores ON Tab_Bairros.Bai_Id = Tab_Doadores.Doa_Bairro_Com´)
  else
    Q_Obtem_Doador.SQL.Add(´FROM Tab_Bairros INNER JOIN Tab_Doadores ON Tab_Bairros.Bai_Id = Tab_Doadores.Doa_Bairro´);

  Q_Obtem_Doador.SQL.Add(´WHERE Tab_Doadores.Doa_Id = ´ + IntToStr(P_Id_Doa));
  Q_Obtem_Doador.SQL.Add(´AND Tab_Bairros.Bai_Fun_Id Is Not Null´);
  Q_Obtem_Doador.SQL.Add(´AND Tab_Doadores.Doa_Status = ´+asp+´A´+asp);
  Q_Obtem_Doador.Open;

  If Q_Obtem_Doador.IsEmpty then
  Begin
    F_Insere_Parcelas2 := ´0´;
    // showmessage(´Retornou 0´);
  End
  Else
  Begin
    V_Dia_Venc := Q_Obtem_Doador.FieldByName(´Doa_Dia_Recebimento´).AsInteger;
    // showmessage(inttostr(V_Dia_Venc));
    V_Dt := FormatFloat(´00´,V_Dia_Venc) + ´/´ + FormatFloat(´00´, StrToInt(copy(P_Mes_Inicial,1,2))) + ´/´ + FormatFloat(´0000´, StrToInt(copy(P_Mes_Inicial,4,4)));

    while True do
      try
        V_Venc_Inicial := StrToDate(V_Dt);
        break;
      except
        V_Dia_Venc := V_Dia_Venc - 1;
        V_Dt := FormatFloat(´00´,V_Dia_Venc) + Copy(V_Dt, 4, 10);
      end;

    if Frequencia = ´M´ then
      V_Cont := 1
    else
    if Frequencia = ´B´ then
      V_Cont := 2
    else
    if Frequencia = ´T´ then
      V_Cont := 3
    else
    if Frequencia = ´Q´ then
      V_Cont := 4
    else
    if Frequencia = ´S´ then
      V_Cont := 6
    else
    if Frequencia = ´A´ then
      V_Cont := 12;

    V_Venc_Aux := V_Venc_Inicial;

    For Freq := 1 to P_Qtde_Parc do
    begin
      V_Venc_Aux := IncMonth(V_Venc_Aux, V_Cont);

      // coloquei o resultado numa variável para que
      // a função seja executada apenas uma vez, e não em
      // todas as avaliações de ´if/else´...
      diautil := F_Obtem_Dia_Util(V_Con, datetostr(V_Venc_Aux));

      if (diautil = ´N´) then
      begin
        if DayOf(V_Venc_Aux) = 1 then
          V_Venc_Aux := V_Venc_Aux + 1
        else
          V_Venc_Aux := V_Venc_Aux - 1;
      end
      else
      if DayOfWeek(V_Venc_Aux) = 1 then
      begin
        if DayOf(V_Venc_Aux) = 1 then
          V_Venc_Aux := V_Venc_Aux + 1
        else
          V_Venc_Aux := V_Venc_Aux - 1;
      end;

      If Not F_Existe_Doacao(V_Con, P_Id_Doa, V_Venc_Aux) then
      Begin
        Q_Apaga_Doacoes.Close;
        Q_Apaga_Doacoes.SQL.Clear;
        Q_Apaga_Doacoes.SQL.Add(´DELETE FROM Tab_Doacoes´);
        Q_Apaga_Doacoes.SQL.Add(´WHERE Tab_Doacoes.Doc_Doa_Id=´ + IntToStr(P_Id_Doa));
        Q_Apaga_Doacoes.SQL.Add(´AND Tab_Doacoes.Doc_Status_Doacao < 4´);
        Q_Apaga_Doacoes.SQL.Add(´AND Tab_Doacoes.Doc_Status_Impressao = 6´);
        Q_Apaga_Doacoes.SQL.Add(´AND Extract(year from Tab_Doacoes.Doc_Data_Operacao)= ´ + FormatDateTime(´yyyy´, V_Venc_Aux));
        Q_Apaga_Doacoes.SQL.Add(´AND Extract(month from Tab_Doacoes.Doc_Data_Operacao)= ´ + FormatDateTime(´mm´, V_Venc_Aux));
        Q_Apaga_Doacoes.ExecSQL;

        Q_Insere_Doacao.Close;
        Q_Insere_Doacao.SQL.Clear;
        Q_Insere_Doacao.SQL.Add(´INSERT INTO Tab_Doacoes´);
        Q_Insere_Doacao.SQL.Add(´(Doc_Doa_Id,Doc_Func_Operadora,Doc_Func_Mensageiro,Doc_Data_Operacao,Doc_Valor)´);
        Q_Insere_Doacao.SQL.Add(´VALUES´);
        Q_Insere_Doacao.SQL.Add(´(´ + asp + IntToStr(P_Id_Doa) + asp +´,´);
        Q_Insere_Doacao.SQL.Add(´´ + asp + Q_Obtem_Doador.FieldByName(´Doa_Operadora´).AsString + asp +´,´);
        Q_Insere_Doacao.SQL.Add(´´ + asp + Q_Obtem_Doador.FieldByName(´Bai_Fun_Id´).AsString + asp + ´,´);
        Q_Insere_Doacao.SQL.Add(asp + FormatDateTime(´mm/dd/yyyy´,V_Venc_Aux) + asp + ´,´);
        Q_Insere_Doacao.SQL.Add(´´ + asp + Q_Obtem_Doador.FieldByName(´Doa_Valor_Parcela´).AsString + asp + ´)´);
        Q_Insere_Doacao.ExecSQL;
      end;

    end;
  
    F_Insere_Parcelas2 := ´1´;
    // showmessage(´Retornou 1´);
  end;

  Freeandnil(Q_Insere_Doacao);
  Freeandnil(Q_Apaga_Doacoes);
  Freeandnil(Q_Obtem_Doador);

end;



GOSTEI 0
Fajo

Fajo

30/09/2008

Oi emerson, blz

o problema já consegui resolver, era uma rotina q era chamada por essa q não estava liberando uma query dinamica, e com relação ao código realmente é necessário dar uma revisada, tô criando coragem.

Obrigado.


GOSTEI 0
POSTAR