Problema de Access Violation en Delphi 7

[[nlsgarcia]]

Hola:

Estoy migrando un driver de POS de una impresora fiscal de PowerBasic 8.0 a Delphi 7, y en la rutina de enviar los comandos a la impresora obtengo siempre alguno de estos errores:

Project C:\Developers\Impresora Fiscal\Delphi 7 PrnFiscal\POSPrnFiscalDLL32.EXE faulted with message: 'access violation at 0x0629f46c: read of address 0x0629f46c'. Process Stoped. Use Step or Runtime to continue.

Project C:\Developers\Impresora Fiscal\Delphi 7 PrnFiscal\POSPrnFiscalDLL32.EXE raised too many consecutive exceptions access violation at 0x00000000: read of address 0x00000000. Process Stoped. Use Step or Runtime to continue.

Considere varias causas para este error y todas fueron descartadas en base a pruebas, las causas descartadas fueron:

01.- Problemas de Instalación con Delphi 7 Enterprise.
02.- Problemas de Update con Delphi 7 Enterprise.
03.- Problemas con Services de WinXP
04.- Problemas con programas en el Startup de WinXP
05.- Problemas con la App Host hecha en VB6 (Se hizo un host básico en Delphi 7 con los mismos resultados)
06.- Problemas con el registro de WinXP
07.- Problemas con la inicialización de la estructura DCB

La rutina ejecuta completamente sin errores, pero al finalizar la última instrucción (La cual ejecuta sin ningun problema, dado que si agrego una nueva instrucción al final de esta como por ejemplo un try..except..end o un simple exit, todas se ejecutan correctamente), da el error antes mencionado. Como dije anteriormente, la misma rutina funciona perfectamente en PowerBasic 8.0, el problema parece ser en mi humilde opinión al liberar los recursos asignados a la función en cuestión SendCmd().

Investigue varias posibles causas de los AV en la pagina web: http://delphi.about.com/od/objectpas.../aa052201a.htm, sin ningun resultado positivo.

He revisado los mensajes de Access Violation en este site (http://www.clubdelphi.com) y no he podido encontrar ninguna información que me ayude a eliminar el error. Lo cierto es que cada mensaje que he leido me ha dado ideas, pero lamentablemente ninguna ha funcionado hasta ahora.

Puedo decirles que llegue al punto de hacer un debub de cada una de las unidades que usa el programa sin ningún resultado.

Se que el error se debe a un acceso indebido a una posición de memoria, y parece que lo más comun es por el uso de objetos que no se han creado o que ya han sido liberados, pero ese no es mi caso.

Lo fundamental de este código es lo siguiente:
1.- No usa BD
2.- Hace uso de las API WIN32 para el manejo del puerto serial, via Overlapped (Aunque falla de igual forma en forma sincronizada).
3.- Esta implementado en forma de DLL.
4.- No hace uso de OOP (De forma directa).
5.- El programa original funciona sin ningún problema en PowerBasic 8.0
6.- Es 100% programatico, no hace uso de DLLs externos, ActiveX o llamadas a ningún tipo de programa externo.
7.- La comunicación con el printer fiscal solo hace uso de las lineas TX y RX, dado que asi esta implementado por hardware, el resto de las lineas del puerto serial rs232 no son utilizadas.
8.- La versión de Delphi que utilizo es Delphi 7.0 Enterprise (Build 8.1), pero el error persiste aun uso el Delphi 7.0 Entreprise sin el Update Pack 7.1
9.- El ambiente de desarrollo es un Pentium III a 1 Ghz, 1GB de Ram, 120 GB de HD con Windows XP SP2.

Agradezco cualquier idea que me puedan dar, muchas gracias de antemano.

La rutina es la siguiente:

Nota: Las rutinas que se muestran en el código más abajo y que no he enviado para minimizar la cantidad de código a revisar y evitar la sobresaturación de información, ejecutan sin ningún problema y los typos de datos Buffer_n son UDT del tipo:

Buffer_n = Record
b : Array[0..n-1] of Byte;
end;

Código Delphi [-]
 
//-----------------------------------------------------------------------------------------------------
// Envia los paquetes de comandos al printer
function SendCmd(
   ProcPrnCmd : String;
   Var PrnCmd : Array of Byte;
   NCharWait : Integer
   ) : Boolean;
var
   i : Integer;
   BytesRead : LongWord;
   BytesWrites : LongWord;
   BytesTransferred : LongWord;
   Buffer2 : Buffer_2;      // Para operaciones de NewDoc, NewItem, CancelTransaction
   Buffer35 : Buffer_35;    // Para operaciones de Variables de Entorno y Estatus de Printer
   Buffer266 : Buffer_266;  // Para operaciones de Consulta Memoria de Trabajo
   Buffer530 : Buffer_530;  // Para operaciones de Consulta Ultimo X
   OvrLap : OVERLAPPED;
   Status1 : Byte;
   Status2 : Byte;
   NPacketBad : Byte;
   SendTimeOut : Boolean;
   cto : COMMTIMEOUTS;
   FResult : Boolean;
   Buffer : Array[0..1] of char;
   AuxBufferIn : String;
   StartTimer : TDateTime;
   EndTimer : TDateTime;
begin
   if not FlagSendCmd then
      FlagSendCmd := True
   else
   begin
      Application.MessageBox(Pchar(MsgDll(46)),'PrnFiscalDLL32',MB_ICONINFORMATION + MB_OK);
      Exit;
   end;
   if not PrnEnabled then OpenPort;
   if not SearchPrn then
   begin
      LogPrnCmd(HstPrnCmd, ProcPrnCmd, MsgDll(27));
      FlagSendCmd := False;
      Exit;
   end;
   LogPrnCmd(HstPrnCmd, ProcPrnCmd, 'Inicio Comando');
   if Countup = 255 then Countup := 0 else Countup := Countup + 1;
   if Countdown = 0 then Countdown := 255 else Countdown := Countdown - 1;
   // Cabecera del paquete: Las Pocisiones PrnCmd(3) al PrnCmd(10) son reservadas para futuras funciones
   PrnCmd[0] := 10;
   PrnCmd[1] := Countup;
   PrnCmd[2] := Countdown;
   NPacketBad := 0;
   CRC16(PrnCmd);
   OvrLap.hEvent := CreateEvent(Nil, True, False, Nil);;
   OvrLap.offset := 0;
   OvrLap.OffsetHigh := 0;
   Repeat
      BufferIn := '';
      cto.ReadIntervalTimeout := 0;
      cto.ReadtotalTimeoutConstant := 0;
      // Debe ser mayor a 5 Seg ( 5000 mseg ) para evitar SendTimeOut
      if NCharWait <= 2 then
         cto.ReadtotalTimeoutMultiplier := 0
      else
         cto.ReadtotalTimeoutMultiplier := 30;
      cto.WritetotalTimeoutConstant := 0;
      cto.WritetotalTimeoutMultiplier := 0;
      FResult := SetCommTimeouts(hCom, cto);
      if not fResult then
      begin
        ShowLastError(GetLastError());
        FlagSendCmd := False;
        Exit;
      end;
      // Transmicion del Paquete de comandos via API
      for i := 0 to 97 do
      begin
         Buffer[i]  := Chr(PrnCmd[i]);
         FResult := WriteFile(hCom, Buffer[i], 1, BytesWrites, @OvrLap);
         if WaitForSingleObject(OvrLap.hEvent, INFINITE) = WAIT_OBJECT_0 then
         begin
            FResult := GetoverlappedResult(hCom, OvrLap, BytesTransferred, True);
            if not fResult then
            begin
               ShowLastError(GetLastError());
               FlagSendCmd := False;
               Exit;
            end
         end
         else
         begin
            Application.MessageBox(Pchar(MsgDll(2)),'PrnFiscalDLL32',MB_ICONINFORMATION + MB_OK);
            FlagSendCmd := False;
            Exit;
         end
      end;
      StartTimer := Time;
      SendTimeOut := False;
      Repeat
         // Application.ProcessMessage no funciona ya que la rutina espera el resultado de GetoverlappedResult
         // Es por eso que se establece un tiempo de 17 segundos de espera en los RptZ (Promedio)
         if NCharWait = 1 then PrnWait(17); // Time Sync Resportes de RptZ
         {
          Recepcion del Paquete de Estatus del Printer via API
          NCharWait = 0   Cheque
          NCharWait = 1   Reportes
          NCharWait = 2   documentos
          NCharWait = 35  Consulta Estatus
          NCharWait = 266 Consulta Memoria de Trabajo
          NCharWait = 530 Consulta Ultimo X
         }
         if NCharWait = 0 then FResult := ReadFile(hCom, Buffer2, 2, BytesRead, @OvrLap);
         if NCharWait = 1 then FResult := ReadFile(hCom, Buffer2, 2, BytesRead, @OvrLap);
         if NCharWait = 2 then FResult := ReadFile(hCom, Buffer2, 2, BytesRead, @OvrLap);
         if NCharWait = 35 then FResult := ReadFile(hCom, Buffer35, 35, BytesRead, @OvrLap);
         if NCharWait = 266 then FResult := ReadFile(hCom, Buffer266, 266, BytesRead, @OvrLap);
         if NCharWait = 530 then FResult := ReadFile(hCom, Buffer530, 530, BytesRead, @OvrLap);
         if WaitForSingleObject(OvrLap.hEvent, INFINITE) = WAIT_OBJECT_0 then
         begin
            FResult := GetoverlappedResult(hCom, OvrLap, BytesTransferred, True);
            if not fResult then
            begin
               ShowLastError(GetLastError());
               FlagSendCmd := False;
               Exit;
            end
         end
         else
         begin
            Application.MessageBox(Pchar(MsgDll(1)),'PrnFiscalDLL32',MB_ICONINFORMATION + MB_OK);
            FlagSendCmd := False;
            Exit;
         end;
         for i := 0 to BytesTransferred - 1 do
         begin
            if NCharWait = 0 then BufferIn := BufferIn + Chr(Buffer2.b[i]);
            if NCharWait = 1 then BufferIn := BufferIn + Chr(Buffer2.b[i]);
            if NCharWait = 2 then BufferIn := BufferIn + Chr(Buffer2.b[i]);
            if NCharWait = 35 then BufferIn := BufferIn + Chr(Buffer35.b[i]);
            if NCharWait = 266 then BufferIn := BufferIn + Chr(Buffer266.b[i]);
            if NCharWait = 530 then BufferIn := BufferIn + Chr(Buffer530.b[i]);
         end;
         if Length(BufferIn) >= 2 then Break;
         EndTimer := Time;
         if EndTimer >= StartTimer + 20 then SendTimeOut := True;
      Until SendTimeOut;
      if SendTimeOut then
      begin
         Application.MessageBox(Pchar(MsgDll(9)),'PrnFiscalDLL32',MB_ICONINFORMATION + MB_OK);
         LogPrnCmd(HstPrnCmd, ProcPrnCmd, MsgDll(9));
         SendCmd := False;
         FlagSendCmd := False;
         Exit;
      end;
      NPacketBad := NPacketBad + 1;
      if Length(BufferIn) > 0 then
      begin
         AuxBufferIn := Copy(BufferIn, 1, 1);
         Status1 := Ord(AuxBufferIn[1]);
         AuxBufferIn := Copy(BufferIn, 2, 1);
         Status2 := Ord(AuxBufferIn[1]);
      end;
   Until (Status1 < 255) OR (NPacketBad > 3);
   // Manejo de Mensajes de Envio y Recepcion
   if (Status1 = 0) and (Status2 = 0) then
   begin
      Application.MessageBox(Pchar(MsgDll(5)),'PrnFiscalDLL32',MB_ICONINFORMATION + MB_OK);
      LogPrnCmd(HstPrnCmd, ProcPrnCmd, MsgDll(5));
      SendCmd := False;
      FlagSendCmd := False;
      Exit;
   end;
   if (Status1 = 171) then
   begin
      Application.MessageBox(Pchar(MsgDll(4)),'PrnFiscalDLL32',MB_ICONINFORMATION + MB_OK);
      LogPrnCmd(HstPrnCmd, ProcPrnCmd, MsgDll(4));
      SendCmd := False;
      FlagSendCmd := False;
      Exit;
   end;
   if Length(BufferIn) < NCharWait then
   begin
      Application.MessageBox(Pchar(MsgDll(1)),'PrnFiscalDLL32',MB_ICONINFORMATION + MB_OK);
      LogPrnCmd(HstPrnCmd, ProcPrnCmd, MsgDll(1));
      SendCmd := False;
      FlagSendCmd := False;
      Exit;
   end;
   if (Status1 = 255) and (NPacketBad >= 2) then
   begin
      Application.MessageBox(Pchar(MsgDll(2)),'PrnFiscalDLL32',MB_ICONINFORMATION + MB_OK);
      LogPrnCmd(HstPrnCmd, ProcPrnCmd, MsgDll(2));
      SendCmd := False;
      FlagSendCmd := False;
      Exit;
   end;
   if (Status1 = 170) and (Status2 = 255) then
   begin
      Application.MessageBox(Pchar(MsgDll(3)),'PrnFiscalDLL32',MB_ICONINFORMATION + MB_OK);
      LogPrnCmd(HstPrnCmd, ProcPrnCmd, MsgDll(3));
      SendCmd := False;
      FlagSendCmd := False;
      Exit;
   end;
   // El Estatus 13 es un Error No Definido que aparece en los Reportes X y Z
   // Si se Ignora no afecta la ejecucion del ActiveX DLL ( ¿68,145,252? )
   if (Status1 = 170) and (Status2 > 0) and (Status2 <> 13) then
   begin
      Application.MessageBox(Pchar(MsgMem(Integer(Status2))),'PrnFiscalDLL32',MB_ICONINFORMATION + MB_OK);
      LogPrnCmd(HstPrnCmd, ProcPrnCmd, 'Err-' + IntToStr(Status2));
      SendCmd := False;
      FlagSendCmd := False;
      Exit;
   end;
   LogPrnCmd(HstPrnCmd, ProcPrnCmd, 'Fin Comando');
   FlagSendCmd := False;
   SendCmd := True;
   CloseHandle(OvrLap.hEvent);
   // Tratando de capturar el error AV
   try
      exit;
   except
      exit;
   end;
end;
//-----------------------------------------------------------------------------------------------------

Gracias por revisar el código.

[[nlsgarcia]]

Hola:

El Error estaba en este fragmento de código:

Código Delphi [-]

Var:
Buffer : Array[0..1] of char;
...
 
Begin
for i := 0 to 97 do
      begin
         Buffer[i]  := Chr(PrnCmd[i]);
...

El índice declarado es menor al índice usado en el for, y el error de índice fuera de secuencia no fue detectado en tiempo de ejecución de forma explicita, sino de forma genérica como un AV, dado que no estaba activa la opción de Range Checking en Runtime, en las opciones del compilador.

Revise una buena parte de los errores que fueron publicados relacionados a Access Violation, en mi humilde opinión yo pienso que parte de la velocidad del compilador de Delphi se debe a un compromiso entre chequeo de elementos en memoria (objetos, variables, estructuras y arreglos) y velocidad de compilación, el cual confia en parte sea responsabilidad del programador, dado que es un lenguaje para uso profesional, a diferencia de VB.

Gracias a las personas que se tomaron la molestia de leer este problema y revisar el código asociado.

[roman]

Pues es que el compilador no tiene manera de saber que el índice está fuera de rango. Tendría que ser un compilador muy avanzado, para poder analizar tu código y darse cuenta de que hay una posible violación de rango, y digo posible, porque el compilador no tiene manera de saber qué va a pasar en el ciclo, quizá algo lo haga salir del bucle antes de llegar al extremo del rango.

Otra cosa sería si pones:

Código Delphi [-]
Buffer[5]  := Chr(PrnCmd[5]);

porque explícitamente le estás diciendo que pase un índice fuera del rango que el compilador ya conoce por la declaración de la variable.

// Saludos

[[nlsgarcia]]

Hola Roman:

Gracias por tu comentario, cambiare la nota que hice a:

El error de índice fuera de secuencia no fue detectado en tiempo de ejecución de forma explicita, sin de forma genérica como un AV.

Saludos.

[roman]

¡Ah! Pero en tiempo de ejecución la cosa cambia . Por defecto, Delphi no verifica el rango, pero sí que puede hacerlo si activas la opción Range Checking en Project|Options|Compiler. Claro que igualmente obtienes una excepción, pero de alguna manera, es menos severa que un Acces Violation.

// Saludos

[[nlsgarcia]]

Hola:

Revise la opción que me indicastes y el error es detectado en el momento que ocurre si esta activa la opción, nuevamente gracias por tu comentario.

Saludos.