10 respuestas en este tema

[FerCastro]

Hola Amigos, un gusto saludarlos, el motivo del post es el siguiente:

Estoy trabajando con Delphi5 Update1/Oracle/WinXP SP3 y es una aplicación un poco compleja y pesada (30Mb el ejecutable), cero librerías de terceros.

Mi problema viene dado cuando se ejecuta un query sobre una tabla de oracle (este query trae a lo mucho 20k registros) y a partir de este query se crea uno o varios archivos de texto. El proceso tiene varios while/for andados y en algún momento de estos ciclos recibo el siguiente error: Invalid Pointer Operation el cual me tira mi aplicación.

He estado investigando las posibles causas y soluciones de este problema, el cual por lo general viene dado por accesos a localidades de memoria que no están usadas, o algún problema con alguna clase, pero en el procedimiento yo no uso clases, mis variables están bien declaradas y no doy pié con bola. Además, el problema nunca surge siempre en el mismo lugar, es decir, a veces surge antes de entrar a los ciclos, otras veces al ejecutar un query, otras veces al momento de llamar a un messagebox, y lo más desconcertante, a veces no sale el mugroso error.

Espero que me puedan echar un cable porque llevo ya varios dias con esto, y después de usar el EurekaLog, el MadException y algunas otras monerias que hallé en la red eto sigue sin solucionarse.

Agradezco mucho la atencion.

Fernando Castro
México, D.F.

[enecumene]

¿seguro dentro de esos ciclos no se están manejando punteros?, normalmente ese tipo de error está relacionados con punteros.

[FerCastro]

¿seguro dentro de esos ciclos no se están manejando punteros?, normalmente ese tipo de error está relacionados con punteros.

Hola Ecumene y mil gracias por la respuesta. No utilizo punteros, lo más que utilizo son dos objetos públicos los cuales no me han dado problema. Uso unos TStringList los cuales después de leer en algún lado los destruyo y los vuelvo a crear. Si gustas puedo poner el código para ver si 4 ojos ven mejor que dos.

Saludos!! y mil gracias

FCG

[enecumene]

Pues eso sería excelente mi estimado .

[FerCastro]

Es extenso, pero pues ojalá se pueda entender bien. Ecumene te agradezco mucho la ayuda, y estoy al pendiente por si tienes alguna duda al respecto del código.


Saludos!!

delphi

Procedure TWIprProces.CrearArchivo(pOper: String);
Var
  vI, vJ, vK, cont: Integer;
  vL, vC, res: TStrings;
  indice: Integer;
  vCad, vTipo, vLong, vDeci, sCampo, sLinea, vId_Cia, vCve_t_cia, vddmm, vaa, vNombre, vObliga: String;
  vNumero: Double;
  bProcesar, bCrear, bCero: Boolean;
  fTxt : TextFile;
  aTot : Array of Extended;
  vlDump: String;
  vCi: TStrings;
  sCadenaSQL : String;
Begin
  memArch.Lines.Clear;
  edTotal.Text := '0';
  memArch.Repaint;
  edTotal.Repaint;
  bCrear := False;
  bCero := False;
  cont := 0;
  {Obtener la configuaracion general de la compañia}
  vddmm := copy(edFFinPer.Text, 1,2)+ copy(edFFinPer.Text, 4,2);
  vaa := copy(edFFinPer.Text, 9,2);
  If qOpen.Active Then
    qOpen.Close;
  qOpen.Sql.Clear;
{$IFDEF SPOT_MULTIEMPRESA} (*
  * El nuevo código para soportar multiempresa *)
  qOpen.Sql.Text := 'SELECT * '+
                      'FROM IPR_CONFIG_GRAL '+
                      'WHERE IPR_Id_Arch = '+ kmSs(vgArch_Global) +
                      ' AND Id_Empresa = ' + Objeto.DameEmpresa;                                  // RJM 26/11/07
// 26/09/2008  SPT-LMBC
{$ELSE} (*
  * El código original *)
          qOpen.Sql.Text := 'SELECT * '+
                      'FROM IPR_CONFIG_GRAL '+
//                      'WHERE IPR_Id_Arch = '+ kmSs('IPR');
                      'WHERE IPR_Id_Arch = '+ kmSs(vgArch_Global);                                  // RJM 26/11/07
{$ENDIF}
  Try
    qOpen.Open;
    If Not qOpen.IsEmpty Then Begin
      vId_Cia := qOpen.FieldByname('IPR_ID_CIA').AsString;
      vCve_t_cia := qOpen.FieldByname('IPR_CVEL_T_CIA').AsString;
    End;
  Finally
    qOpen.Close;
    qOpen.Sql.Clear;
  End;
 
  SetLength(aTot, 30);
  For vI := 0 To (vgArchivos.Count - 1) Do Begin
    bProcesar := False;
 
 
 
 
    bProcesar := (vgArchivos.Strings[vI] <> cgICC);
    If Not((FindComponent(vgLstDanSum.Strings[vI] ) As TCheckBox).Checked) Then
      bProcesar := False;
 
 
 
    If bProcesar Then Begin
 
      vL  := TStringLIst.Create;
      vC  := TStringLIst.Create;
      vCi := TStringLIst.Create;
      res := TStringLIst.Create;
 
      
      If qOpen.Active Then
        qOpen.Close;
      If qArchivo.Active Then
        qArchivo.Close;
      {Leer lineas del archivo}
{$IFDEF SPOT_MULTIEMPRESA} (*
  * El nuevo código para soportar multiempresa *)
      qArchivo.Sql.Text := 'SELECT /*+ INDEX IPR_ARCHIVO(PK_IPR_ARCHIVO) */ '+
                                  '* '+
                              'FROM IPR_ARCHIVO '+
                                'WHERE IPR_F_FIN_PER   = '+ ToDate__(edFFinPer.Text)+
                                  'AND ID_EMPRESA      = '+ Objeto.DameEmpresa+
                                  'AND IPR_ID_ARCH     = '+ kmSs(vgArchivos.Strings[vI])+
                                  'AND IPR_CVEL_T_OPER = '+ kmSs(pOper)+
                                  'AND IPR_CVEL_ORIGEN = '+ kmSs(vgOrig_Out)+
                                'ORDER BY 5 ';
// 30/09/2008  SPT-LMBC
{$ELSE} (*
  * El código original *)
      qArchivo.Sql.Text := 'SELECT /*+ INDEX IPR_ARCHIVO(PK_IPR_ARCHIVO) */ '+
                                  '* '+
                              'FROM IPR_ARCHIVO '+
                                'WHERE IPR_F_FIN_PER   = '+ ToDate__(edFFinPer.Text)+
                                  'AND IPR_ID_ARCH     = '+ kmSs(vgArchivos.Strings[vI])+
                                  'AND IPR_CVEL_T_OPER = '+ kmSs(pOper)+
                                  'AND IPR_CVEL_ORIGEN = '+ kmSs(vgOrig_Out)+
                                'ORDER BY 5 ';
{$ENDIF}
      qArchivo.Open;
      bCero := False;
      While Not qArchivo.Eof Do Begin
        sLinea := qArchivo.FieldByName('IPR_Datos_1').AsString;
        If Trim(sLinea) = '0' Then
          bCero := True;
        If pos('|', sLinea) > 0 Then Begin
          sLinea := StringReplace(sLInea, '|', cgSC, [rfReplaceAll]);
        End;
        vC.Add(qArchivo.FieldByName('IPR_Datos_1').AsString);
         vCi.Add(qArchivo.FieldByName('IPR_Id_Consec').AsString+ '\1'); // GFCG
        If Length(qArchivo.FieldByName('IPR_Datos_2').AsString) > 0 Then
          vC.Add(qArchivo.FieldByName('IPR_Datos_2').AsString);
           vCi.Add(qArchivo.FieldByName('IPR_Id_Consec').AsString+ '\2'); // GFCG
        If Length(qArchivo.FieldByName('IPR_Datos_3').AsString) > 0 Then
          vC.Add(qArchivo.FieldByName('IPR_Datos_3').AsString);
           vCi.Add(qArchivo.FieldByName('IPR_Id_Consec').AsString+ '\3'); // GFCG
        qArchivo.Next;
      End;
      vNombre := Objeto.Nombre_Arch(vgArchivos.Strings[vI], vId_Cia, pOper, vddmm, vaa, vCve_t_cia);
      Try
        Rewrite_Archivo_Txt(vgRuta, vNombre, fTxt);
        If vC.Count > 0 Then Begin
          {Leer configuracion del formato}
          If qOpen.Active Then
            qOpen.Close;
          If qFormato.Active Then
            qFormato.Close;                                                                           // RJM 20/01/09
          {Leer lineas del archivo}
          {$IFDEF SPOT_MULTIEMPRESA} (*
            * El nuevo código para soportar multiempresa *)
                      qFormato.Sql.Text := 'SELECT * '+
                                 'FROM IPR_CONFIG_ARCH '+
                                 'WHERE IPR_Id_Arch '+  '= '+ kmSs(vgArchivos.Strings[vI])+
                                 'AND ID_EMPRESA = ' + Objeto.DameEmpresa +
                                 'AND IPR_Id_Arch_Glob = '+ kmSs(vgArch_Global);                   // RJM 26/11/07
           {$ELSE} (*
            * El código original *)
                  qFormato.Sql.Text := 'SELECT * '+
                                  'FROM IPR_CONFIG_ARCH '+
                                  'WHERE IPR_Id_Arch '+  '= '+ kmSs(vgArchivos.Strings[vI])+
                                      'AND IPR_Id_Arch_Glob = '+ kmSs(vgArch_Global);                   // RJM 26/11/07
          {$ENDIF}
          qFormato.Open;
          vCad := qFormato.FieldByName('IPR_FMTO_CAMPOS').AsString;
 
 
 
Try
          If Not bCero Then Begin
            For vJ := 0 To (qFormato.FieldByName('IPR_NUM_CAMPOS').AsInteger - 1) Do Begin
             indice := pos(cgSR, vCad);
              vL.Add(copy(vCad, 1, indice));
              vCad := copy(vCad, indice+ 1, Length(vCad));
              aTot[vJ] := 0;
              qFormato.Next;
            End;
            vJ   := 0;
            vCad := '';
             While vJ < vC.Count Do Begin
              sLinea := '';
              For vK := 0 To (qFormato.FieldByName('IPR_NUM_CAMPOS').AsInteger - 1) Do Begin
                If Length(vCad) = 0 Then
                  vCad := vC.Strings[vJ];
                sCampo  := ObtPosCampo_sSep(vCad, vJ, vK, (qFormato.FieldByName('IPR_NUM_CAMPOS').AsInteger - 1));
                If ObtPosCampo(vL.Strings[vK], 2) = 'CONTROL' Then Begin
                  aTot[vK] := -1234567890987654321;
                End Else Begin
                  vTipo   := ObtPosCampo(vL.Strings[vk], 3);        //Tipo de Dato
                 vLong   := ObtPosCampo(vL.Strings[vk], 4);        //Longitud
                  vDeci   := ObtPosCampo(vL.Strings[vk], 5);        //Número decimales
                  vObliga := ObtPosCampo(vL.Strings[vk], 7);        //Campo Obligatorio
                 If          vTipo = 'C' Then Begin
                    If Trim(vLong) <> '' Then Begin
                     If (((vgArchivos.Strings[vI]        = 'DGAUI') Or
                           (vgArchivos.Strings[vI]        = 'DGAUF')   ) And
                          (ObtPosCampo(vL.Strings[vK], 2) = 'ESTATUS')   And
                          (Length(sCampo)                 = 2)           And
                          (vLong                          = '2')            ) Then
                        sCampo := copy(sCampo, 2, 1)
                      Else
                        sCampo := copy(sCampo, 1, StrToInt(vLong));
                   End;
                    If ((vObliga      =  'T') or
                        (Trim(sCampo) <> '')    ) Then Begin
                     aTot[vK] := aTot[vK] + 1;
                    End;
                  End Else If vTipo = 'F' Then Begin
                    If Trim(sCampo) <> '' Then Begin
                      {formatear la fecha}
                      sCampo := FormatMaskText('##/##/####', sCampo);
                    End;
                    If ((vObliga      =  'T') or
                        (Trim(sCampo) <> '')    ) Then Begin
                      aTot[vK] := aTot[vK] + 1;
                    End;
                  End Else If vTipo = 'N' Then Begin
                    vNumero := 0;
                    If Trim(vDeci) = '' Then Begin
                      vDeci := '0';
                    End;
                     If          Trim(sCampo) <> '' Then Begin
                      vNumero := StrToFloat(sCampo);
                      sCampo := Format('%'+ vLong+ '.'+ vDeci+ 'f', [vNumero]);
                    End Else If vObliga = 'T' Then Begin
 
                      sCampo := Format( '%1'+ '.'+ vDeci+ 'f', [0.00]);
 
                    End;
 
                    aTot[vK] := Redondear((aTot[vK] + vNumero), StrToInt(vDeci));
 
                  End;
 
                  sCAmpo := Trim(sCampo);
 
                  sLinea := sLinea+ sCampo+ '|';
 
                End;
 
              End; //for vK
 
              If          UpperCase(Objeto.ClassName) = 'TIPRPROCES' Then Begin
                sLinea := copy(sLinea, 1, Length(sLinea) - 1)+ ';';
              End Else If UpperCase(Objeto.ClassName) = 'TSES07PROC' Then Begin
                sLinea := sLinea+ ';';
              End;
              WriteLn(fTxt, sLinea);
            End; //for vJ
            If UpperCase(Objeto.ClassName) = 'TSES07PROC' Then Begin
              sLinea := '';
              For vK := Low(aTot) To (qFormato.FieldByName('IPR_NUM_CAMPOS').AsInteger - 1) Do Begin
                If aTot[vK] <> -1234567890987654321 Then
                  sLinea := sLinea+ FloatToStr(aTot[vK])+ '|';
              End;
              sLinea := sLinea+ ';';
              WriteLn(fTxt, sLinea);
            End;
 
          memArch.Lines.Add(vNombre);
 
 
          End Else Begin
            sLinea := '0';
            WriteLn(fTxt, sLinea);
          End;
          cont := cont+ 1;
          edTotal.Text := IntToStr(cont);
          edTotal.Repaint;
          memArch.Repaint;
          bCrear := True;
 
 
 
{$IFDEF SPOT_MULTIEMPRESA} (*
  * El nuevo código para soportar multiempresa *)
 
 
          sCadenaSQL :=  'UPDATE IPR_PROCESO '+
                                    ' SET IPR_NOM_ARCH = '+ QuotedStr(vNombre)+
                                    ' WHERE IPR_F_FIN_PER   = '+ ToDate__(edFFinPer.Text)+
                                    ' AND ID_EMPRESA      = '+ Objeto.DameEmpresa+
                                    ' AND IPR_ID_ARCH     = '+ kmSs(vgArchivos.Strings[vI])+
                                    ' AND IPR_CVEL_T_OPER = '+ kmSs(pOper);
 
           Application.ProcessMessages;
           RunSQL(sCadenaSQL,Objeto.Apli.DataBaseName, Objeto.Apli.SessionName, True);
 
 
 
{$ELSE} (*
  * El código original *)
 
          sCadenaSQL :=  'UPDATE IPR_PROCESO '+
                         ' SET IPR_NOM_ARCH = '+ QuotedStr(vNombre)+
                         ' WHERE IPR_F_FIN_PER   = '+ ToDate__(edFFinPer.Text)+
                         ' AND IPR_ID_ARCH     = '+ kmSs(vgArchivos.Strings[vI])+
                         ' AND IPR_CVEL_T_OPER = '+ kmSs(pOper);
 
           Application.ProcessMessages;
           RunSQL(sCadenaSQL,Objeto.Apli.DataBaseName, Objeto.Apli.SessionName, True);
 
 
{$ENDIF}
 
          If vgArch_Global = 'SES07' Then Begin
            Try
{$IFDEF SPOT_MULTIEMPRESA} (*
  * El nuevo código para soportar multiempresa *)
 
            sCadenaSQL :=  ' INSERT INTO IPR_ARCHIVO '+
                           ' (IPR_F_Fin_Per, ID_EMPRESA,  IPR_Id_Arch,   IPR_CveL_T_Oper, '+
                           ' IPR_CveL_Origen, IPR_Id_Consec, IPR_Datos_1) '+
                           ' VALUES ('+ ToDate__(edFFinPer.Text)+ ', '+
                             Objeto.DameEmpresa+', '+
                             kmS(vgArchivos.Strings[vI])+ ', '+
                             kmS(pOper)+ ', '+
                             kmS(cgSuma)+ ', '+
                           ' 1, '+
                             kmS('SUMATORIA GENERADA')+ ')';
 
            Application.ProcessMessages;
            RunSQL(sCadenaSQL,Objeto.Apli.DataBaseName, Objeto.Apli.SessionName, True);
 
{$ELSE} (*
  * El código original *)
 
            sCadenaSQL :=  ' INSERT INTO IPR_ARCHIVO '+
                           ' (IPR_F_Fin_Per,   IPR_Id_Arch,   IPR_CveL_T_Oper, '+
                           ' IPR_CveL_Origen, IPR_Id_Consec, IPR_Datos_1) '+
                           ' VALUES ('+ ToDate__(edFFinPer.Text)+ ', '+
                             kmS(vgArchivos.Strings[vI])+ ', '+
                             kmS(pOper)+ ', '+
                             kmS(cgSuma)+ ', '+
                           ' 1, '+
                             kmS('SUMATORIA GENERADA')+ ') ';
 
            Application.ProcessMessages;
            RunSQL(sCadenaSQL,Objeto.Apli.DataBaseName, Objeto.Apli.SessionName, True);
 
{$ENDIF}
            Except
 
 
            End;
 
          End;
 
 
Except
 //ShowMessage(vlDump+ kr+ '>'+ vCi.Strings[vJ]+ '<');
 Raise;
End;
        End; //of .count > 0
      Finally
        CloseFile(fTxt);
      End;
 
     FreeAndNil(vL);
     FreeAndNil(vC);
     FreeAndNil(res);
     FreeAndNil(vCi);
 
    End;
 
 
 
 
  End; //for
  If vgArch_Global = 'IPR' Then Begin
    //Crear Archivo ICC
    If qArchivo.Active Then
      qArchivo.Close;
    {Leer lineas del archivo}
{$IFDEF SPOT_MULTIEMPRESA} (*
  * El nuevo código para soportar multiempresa *)
    qArchivo.Sql.Text := 'SELECT * '+
                            'FROM IPR_ARCHIVO '+
                            'WHERE IPR_F_FIN_PER   = '+ ToDate__(edFFinPer.Text)+
                              'AND ID_EMPRESA      = '+ Objeto.DameEmpresa+
                              'AND IPR_CVEL_T_OPER = '+ kmSs(pOper)+
                              'AND IPR_CVEL_ORIGEN = '+ kmSs(vgOrig_Out)+
                              'AND IPR_ID_ARCH     = '+ kmSs(cgICC)+
                            'ORDER BY IPR_ID_CONSEC';
{$ELSE} (*
  * El código original *)
    qArchivo.Sql.Text := 'SELECT * '+
                            'FROM IPR_ARCHIVO '+
                            'WHERE IPR_F_FIN_PER   = '+ ToDate__(edFFinPer.Text)+
                              'AND IPR_CVEL_T_OPER = '+ kmSs(pOper)+
                              'AND IPR_CVEL_ORIGEN = '+ kmSs(vgOrig_Out)+
                              'AND IPR_ID_ARCH     = '+ kmSs(cgICC)+
                            'ORDER BY IPR_ID_CONSEC';
{$ENDIF}
    qArchivo.Open;
    res.Clear;
    While Not qArchivo.Eof Do Begin
      sLinea := qArchivo.FieldByName('IPR_DATOS_1').AsString;
      sLinea := StringReplace(sLinea, cgSC, '|', [rfReplaceAll]);
      sLinea := StringReplace(sLinea, cgSR, ';', [rfReplaceAll]);
      res.Add(sLinea);
      qArchivo.Next;
    End;
    If Not DirectoryExists(vgRuta) Then
      CreateDir(vgRuta);
    vNombre := cgICC+ vId_Cia+ pOper+  vddmm+ '.'+ vaa+ vCve_t_cia;
    res.SaveToFile(vgRuta+ vNombre);
    memArch.Lines.Add(vNombre);
    cont := cont+ 1;
    edTotal.Text := IntToStr(cont);
    edTotal.Repaint;
    memArch.Repaint;
 
    qArchivo.Close;
 
  End;
  If bCrear Then
    LlamaMsg(Objeto.Apli,1,102,'Creación Archivos IPR para '+ pOper)
  Else
    Application.MessageBox(pchar('No existe información necesaria para crear archivos.'), 'Information', MB_OK);
 

[enecumene]

wow, es extenso si , pues tendremos que tomarnos el tiempo de revisarlo al paso.

[Rolphy Reyes]

Saludos.

FerCastro no entiendo correctamente como se puede producir el error.  Pero a manera de consejo te invito a que Subdividas más tu código.

Me refiero a que uses más funciones o procedimientos en el lugar adecuado, así hasta para conseguir un Bug es mucho mas sencillo de corregir y para entender también.

[TiammatMX]

¡¡Mapacheeee!!, qué gusto encontrarte nuevamente en un foro de Delphi.

Bueno, al grano. Creo que podrías ponerle un poco de menos trabajo a la memoria si le pones dentro de alguno de los ciclos un "Application.ProcessMessages" para que no "sufra" el procesador con tanta carga.

Creo que AlGonzález me mostró alguna vez un SQL que tenía embebido un ProcessMessages, o fue Onti, la verdad no recuerdo. Pero te puedo asegurar que si lo pones, no te vas a arrepentir, y hasta podría ser que resuelvas tu caso insoluble.

Saludines, Inge.

[FerCastro]

Mi estimado Jelipe!!

Muchas gracias por la respuesta. Puse unos antes de ejecutar unos querys al final, pero voy a menter unos más dentro de los ciclos principales,  a ver que tal furula.

Y si, estoy dividiendo mi código (que no es mio, más bien me aventaron este torito).

Saludos!! y muchas gracias por las respuestas

Fernando C
Mapache
México, D.F

[FerCastro]

Hola al foro de nuevo

Por fin pude resolver el problema del Invalid Pointer Operation. Estuve depurando linea por linea y bloque por bloque hasta que por fin vi que el querido Delphi 5 tiene problemas con lo siguiente:

aTot : Array of Extended;

delphi

aTot : Array of Extended; // Declaración de un arreglo extended
 
aTot[vJ] := 0;

Al momento de hacer una asignación sobre algún elemento de este arreglo el sistema me marcaba invalid pointer operation, no se por qué simplemente lo hacía.

Como lo resolví?? creeé un record:

delphi

type
   TTotales = Record
     nTotal : Extended;
   end;
 
// Y ya nadamas fué llamar a el campo del mismo
 
aTotales[vJ].nTotal := 0;

Y listo. Caso para la araña, pues al llamar al array de valores error, al llamar al arrar de records listo.


Gracias!! las sugerencias fueron realmente buenas.

[poliburro]

Hola al foro de nuevo

Por fin pude resolver el problema del Invalid Pointer Operation. Estuve depurando linea por linea y bloque por bloque hasta que por fin vi que el querido Delphi 5 tiene problemas con lo siguiente:

aTot : Array of Extended;

delphi

aTot : Array of Extended; // Declaración de un arreglo extended
 
aTot[vJ] := 0;

Al momento de hacer una asignación sobre algún elemento de este arreglo el sistema me marcaba invalid pointer operation, no se por qué simplemente lo hacía.

Como lo resolví?? creeé un record:

delphi

type
   TTotales = Record
     nTotal : Extended;
   end;
 
// Y ya nadamas fué llamar a el campo del mismo
 
aTotales[vJ].nTotal := 0;

Y listo. Caso para la araña, pues al llamar al array de valores error, al llamar al arrar de records listo.


Gracias!! las sugerencias fueron realmente buenas.

Sigo pensando amigo que es un error de lógica, por que he usado arreglos dinámicos y cuando tengo errores es por una mala asignación de memoria.

Pero, me alegra que se haya solucionado tu problema, un saludo cordial