Recent

« previous next »
Pages: [1]

Author Topic: this error drive me crazy  (Read 5518 times)

nestork

  • New member
  • *
  • Posts: 7
this error drive me crazy
« on: July 29, 2015, 02:35:20 pm »
hi everybody, i make a program for get data to weather station, this aplication downloada a txt and show info in form, but some times get error List index(0) out of bounds, and i dont know why. attached my code
Code: [Select]
unit Main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ComCtrls, ExtCtrls, Grids, Buttons, ftpsend, httpsend;

type

  { TForm1 }

  TForm1 = class(TForm)
    ButtonLeerTXT: TButton;
    ButtonDescargar: TButton;
    Image1: TImage;
    ImageBanner: TImage;
    LabelDirViento: TLabel;
    LabelUVientos: TLabel;
    LabelWspeed: TLabel;
    LabelPresion2: TLabel;
    LabelVer: TLabel;
    LabelH: TLabel;
    LabelUPresion: TLabel;
    LabelULluvia: TLabel;
    LabelUT: TLabel;
    LabelDatoTemp: TLabel;
    LabelDatoPresion: TLabel;
    BannerFecha: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    LabelDatoLluvia: TLabel;
    LabelPresion1: TLabel;
    LabelUST: TLabel;
    LabelUT1: TLabel;
    LabelUT2: TLabel;
    LabelVersion: TLabel;
    LabelHoraDatos: TLabel;
    LabelFechadeDatos: TLabel;
    LabelDatoHum: TLabel;
    LabelDatoST: TLabel;
    LabelHum: TLabel;
    LabelPresion: TLabel;
    LabelTemp: TLabel;
    LabelST: TLabel;
    StatusBarEstado: TStatusBar;
    TimerLeer: TTimer;
    TimerDownload: TTimer;
    procedure BorrarFichero(Fichero: String);
    procedure ButtonDescargarClick(Sender: TObject);
    procedure ButtonLeerTXTClick(Sender: TObject);
    function DiasdesdeLanzamiento(StrHoy:string): Integer;
    function DownloadHTTP(URL, TargetFile: string): Boolean;
    function CalculaDirVientos(Dir:String): String;
    procedure LeerDatos;
    procedure FormCreate(Sender: TObject);
    procedure TimerDownloadTimer(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;
const FechaActivacion='20/07/15';
const DiasLicencia=30;
var
  Form1: TForm1;
  lineaNovedades:string;
  lineaDatos:string;
  ArrayDatos: TStringList;

implementation

{$R *.lfm}

{ TForm1 }
procedure TForm1.BorrarFichero(Fichero: String);
begin
  if FileExists(fichero) then
    DeleteFile(fichero);
end;
function TForm1.DiasdesdeLanzamiento(StrHoy:string): Integer;
var
  FechaHoy,FechaLanzamiento:TDate;
begin
     FechaHoy:=StrToDate(StrHoy);
     FechaLanzamiento:=StrToDate(FechaActivacion);
     Result := Trunc (FechaHoy - FechaLanzamiento);
end;

procedure TForm1.ButtonDescargarClick(Sender: TObject);
var
  Resultadoinfo,ResultadoNews,ResultadoBanner:Boolean;
begin
  //ButtonDescargar.Visible:=False;
  TimerLeer.Enabled:=False;
  //BorrarFichero('C:\eclima\realtime.txt');
  ArrayDatos.Clear;
  Resultadoinfo:=False;
  ResultadoNews:=False;
  ResultadoBanner:=False;
  LineaNovedades:='';
  StatusBarEstado.SimpleText:='Descargando información...';
  DownloadHTTP('http://www.climaesperanza.com.ar/realtime.txt','C:\eclima\realtime.txt');
  Resultadoinfo:=DownloadHTTP('http://www.climaesperanza.com.ar/realtime.txt','C:\eclima\realtime.txt');
  if(Resultadoinfo=False) then StatusBarEstado.SimpleText:='Error descargando informacion...'
  else
  begin
    StatusBarEstado.SimpleText:='Información descargada con exito!';
    //LeerDatos;
    TimerLeer.Enabled:=True; ///Habilito despues de descargar
  end;
  //StatusBarEstado.SimpleText:='Descargando novedades...';
  //DownloadHTTP('http://www.climaesperanza.com.ar/novedades.txt','C:\eclima\novedades.txt');
  //ResultadoNews:=DownloadHTTP('http://www.climaesperanza.com.ar/novedades.txt','C:\eclima\novedades.txt');
  //if(ResultadoNews=False) then StatusBarEstado.SimpleText:='Error descargando novedades...'
  //else
   // begin
    //StatusBarEstado.SimpleText:='Novedades descargadas con exito!';
    //LeerNovedades;
    ///MemoNews.Caption:=LineaNovedades;
    //end;
  DownloadHTTP('http://www.climaesperanza.com.ar/images/banner.gif','C:\eclima\banner.gif');
  ResultadoBanner:=DownloadHTTP('http://www.climaesperanza.com.ar/images/banner.gif','C:\eclima\banner.gif');
  if(ResultadoBanner=False) then StatusBarEstado.SimpleText:='Error descargando Banner...'
  else
    begin
    StatusBarEstado.SimpleText:='Descarga de Banner exitosa...';
    ImageBanner.Picture.LoadFromFile('C:\eclima\banner.gif');
    end;
  if ((ResultadoBanner=False)or(Resultadoinfo=False))then StatusBarEstado.SimpleText:='Error Descargando archivos...'
  else StatusBarEstado.SimpleText:='Descarga exitosa...';
end;

procedure TForm1.ButtonLeerTXTClick(Sender: TObject);
begin
  if FileExists('C:\eclima\realtime.txt') then
  LeerDatos;
end;

function TForm1.DownloadHTTP(URL, TargetFile: string): Boolean;
// Download file; retry if necessary.
// Could use Synapse HttpGetBinary, but that doesn't deal
// with result codes (i.e. it happily downloads a 404 error document)
const
  MaxRetries = 3;
var
  HTTPGetResult: Boolean;
  HTTPSender: THTTPSend;
  RetryAttempt: Integer;
begin
  Result := False;
  RetryAttempt := 1;
  HTTPSender := THTTPSend.Create;
  try
    try
      // Try to get the file
      HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
      while (HTTPGetResult = False) and (RetryAttempt < MaxRetries) do
      begin
        Sleep(500 * RetryAttempt);
        HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
        RetryAttempt := RetryAttempt + 1;
      end;
      // If we have an answer from the server, check if the file
      // was sent to us.
      case HTTPSender.Resultcode of
        100..299:
          begin
            HTTPSender.Document.SaveToFile(TargetFile);
            Result := True;
          end; //informational, success
        300..399: Result := False; // redirection. Not implemented, but could be.
        400..499: Result := False; // client error; 404 not found etc
        500..599: Result := False; // internal server error
        else Result := False; // unknown code
      end;
    except
      // We don't care for the reason for this error; the download failed.
      Result := False;
    end;
  finally
    HTTPSender.Free;
  end;
end;
function TForm1.CalculaDirVientos(Dir:String):String;
begin
  if (Dir='NW')then Result:='NO' else
  if (Dir='NNW')then Result:='NNO' else
  if (Dir='WNW')then Result:='0NO' else
  if (Dir='SW')then Result:='SO' else
  if (Dir='SSW')then Result:='SSO' else
  if (Dir='WSW')then Result:='OSO' else
  if (Dir='W')then Result:='O' else
  if (Dir='E')then Result:='E' else
  if (Dir='N')then Result:='N' else
  if (Dir='S')then Result:='S' else
  if (Dir='NNE')then Result:='NNE' else
  if (Dir='NE')then Result:='NE' else
  if (Dir='ENE')then Result:='ENE' else
  if (Dir='ESE')then Result:='ESE' else
  if (Dir='SSE')then Result:='SSE' else
  if (Dir='SE')then Result:='SE' else
  Result:=Dir;
end;

procedure TForm1.LeerDatos;
var f : TextFile;
    DiasPasados:integer;
begin
  AssignFile(f,'c:\eClima\realtime.txt');
  Reset(f);
  Readln(f, lineaDatos);
  Closefile(f);
  ExtractStrings([' '],[],PChar(lineaDatos),ArrayDatos);
  DiasPasados:=DiasdesdeLanzamiento(ArrayDatos[0]);
  //Label1.Caption:=IntToStr(ArrayDatos.Count);
  if(DiasPasados<=DiasLicencia)then
  begin
  LabelFechadeDatos.Caption:=ArrayDatos[0];
  LabelHoraDatos.Caption:=ArrayDatos[1];
  LabelDatoTemp.Caption:=ArrayDatos[2];
  LabelUT.Caption:=ArrayDatos[14];
  LabelDatoHum.Caption:=ArrayDatos[3];
  LabelDatoPresion.Caption:=ArrayDatos[10];
  LabelUPresion.Caption:=ArrayDatos[15];
  LabelDatoST.Caption:=ArrayDatos[24];
  LabelUST.Caption:=ArrayDatos[14];
  LabelDatoLluvia.Caption:=ArrayDatos[9];
  LabelULluvia.Caption:=ArrayDatos[16];
  LabelWspeed.Caption:=ArrayDatos[5];
  LabelUVientos.Caption:=ArrayDatos[13];
  LabelDirViento.Caption:=CalculaDirVientos(ArrayDatos[51]);
 /// ButtonDescargar.Visible:=True;
  end
  else
  begin
  ShowMessage('Debe descargar la version actualizada de eClima...');
  TimerDownload.Enabled:=False;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Resultadoinfo,ResultadoNews,ResultadoBanner:Boolean;
begin
  ArrayDatos:=TstringList.Create;
  Resultadoinfo:=False;
  ResultadoNews:=False;
  ResultadoBanner:=False;
  LineaNovedades:='';
  CreateDir('C:\eClima');
  StatusBarEstado.SimpleText:='Descargando información...';
  DownloadHTTP('http://www.climaesperanza.com.ar/realtime.txt','C:\eclima\realtime.txt');
  Resultadoinfo:=DownloadHTTP('http://www.climaesperanza.com.ar/realtime.txt','C:\eclima\realtime.txt');
  if(Resultadoinfo=False) then StatusBarEstado.SimpleText:='Error descargando informacion...'
  else
  begin
    StatusBarEstado.SimpleText:='Información descargada con exito!';
    LeerDatos;
  end;
  //StatusBarEstado.SimpleText:='Descargando novedades...';
  //DownloadHTTP('http://www.climaesperanza.com.ar/novedades.txt','C:\eclima\novedades.txt');
  //ResultadoNews:=DownloadHTTP('http://www.climaesperanza.com.ar/novedades.txt','C:\eclima\novedades.txt');
  //if(ResultadoNews=False) then StatusBarEstado.SimpleText:='Error descargando novedades...'
  //else
   // begin
   // StatusBarEstado.SimpleText:='Novedades descargadas con exito!';
    //LeerNovedades;
    //MemoNews.Caption :=LineaNovedades;
    //end;
  DownloadHTTP('http://www.climaesperanza.com.ar/images/banner.gif','C:\eclima\banner.gif');
  ResultadoBanner:=DownloadHTTP('http://www.climaesperanza.com.ar/images/banner.gif','C:\eclima\banner.gif');
  if(ResultadoBanner=False) then StatusBarEstado.SimpleText:='Error descargando Banner...'
  else
    begin
    StatusBarEstado.SimpleText:='Descarga de Banner exitosa...';
    ImageBanner.Picture.LoadFromFile('C:\eclima\banner.gif');
    end;
  if ((ResultadoBanner=False)or(Resultadoinfo=False)) then StatusBarEstado.SimpleText:='Error Descargando archivos...'
  else StatusBarEstado.SimpleText:='Descarga exitosa...';
end;

procedure TForm1.TimerDownloadTimer(Sender: TObject);
begin

end;

end.
« Last Edit: July 29, 2015, 03:31:49 pm by nestork »
Logged

eny

  • Hero Member
  • *****
  • Posts: 1634
Re: this error drive me crazy
« Reply #1 on: July 29, 2015, 02:39:26 pm »
What line gives the error?
Logged
All posts based on: Win10 (Win64); Lazarus 2.0.10 'stable' (x64) unless specified otherwise...

nestork

  • New member
  • *
  • Posts: 7
Re: this error drive me crazy
« Reply #2 on: July 29, 2015, 03:27:25 pm »
i dont know which is the line that have error, this is the problem, the error occurs in execution time, some time, at irregular period of time. This is the error image: http://pasteboard.co/2jXAI5BV.gif
« Last Edit: July 29, 2015, 03:37:29 pm by nestork »
Logged

howardpc

  • Hero Member
  • *****
  • Posts: 4144
Re: this error drive me crazy
« Reply #3 on: July 29, 2015, 03:32:24 pm »
Since you hard-code the indexes used for your stringlist data, you should protect access in the procedure LeerDatos, in case the downloaded data does not fill the stringlist as you assume it will.
The line
Code: [Select]
  if(DiasPasados<=DiasLicencia) then
should be
Code: [Select]
  if(DiasPasados<=DiasLicencia) and (ArrayDatos.Count > 51) then   

You should also add a form OnDestroy event where ArrayDatos is freed after use to prevent a memory leak.
Logged

bylaardt

  • Sr. Member
  • ****
  • Posts: 309
Re: this error drive me crazy
« Reply #4 on: July 29, 2015, 03:36:59 pm »
try this:
Code: [Select]
procedure TForm1.LeerDatos;
var f : TextFile;
    DiasPasados:integer;
begin
  AssignFile(f,'c:\eClima\realtime.txt');
  Reset(f);
  Readln(f, lineaDatos);
  Closefile(f);
  ExtractStrings([' '],[],PChar(lineaDatos),ArrayDatos);
  if ArrayDatos.count>0 then
    begin
      DiasPasados:=DiasdesdeLanzamiento(ArrayDatos[0]);
      if(DiasPasados<=DiasLicencia) and (ArrayDatos.count>50)then
        begin
          LabelFechadeDatos.Caption:=ArrayDatos[0];
          LabelHoraDatos.Caption:=ArrayDatos[1];
          LabelDatoTemp.Caption:=ArrayDatos[2];
          LabelUT.Caption:=ArrayDatos[14];
          LabelDatoHum.Caption:=ArrayDatos[3];
          LabelDatoPresion.Caption:=ArrayDatos[10];
          LabelUPresion.Caption:=ArrayDatos[15];
          LabelDatoST.Caption:=ArrayDatos[24];
          LabelUST.Caption:=ArrayDatos[14];
          LabelDatoLluvia.Caption:=ArrayDatos[9];
          LabelULluvia.Caption:=ArrayDatos[16];
          LabelWspeed.Caption:=ArrayDatos[5];
          LabelUVientos.Caption:=ArrayDatos[13];
          LabelDirViento.Caption:=CalculaDirVientos(ArrayDatos[51]);
        end
      else
        begin
          ShowMessage('Debe descargar la version actualizada de eClima...');
          TimerDownload.Enabled:=False;
        end;
    end
  else begin
    ShowMessage('No hay datos en la primera línea');
    TimerDownload.Enabled:=False;
  end;
end;
Logged

howardpc

  • Hero Member
  • *****
  • Posts: 4144
Re: this error drive me crazy
« Reply #5 on: July 29, 2015, 07:47:14 pm »
Quote from: bylaardt on July 29, 2015, 03:36:59 pm
try this:
Code: [Select]
procedure TForm1.LeerDatos;
...
    if(DiasPasados<=DiasLicencia) and (ArrayDatos.count>50) then

@bylaardt: The highest index nestork uses is 51, which would be accessible if the Count is 52 or more. Hence the condition should be
Code: [Select]
  if (DiasPasados<=DiasLicencia) and (ArrayDatos.Count>51)then
Logged

nestork

  • New member
  • *
  • Posts: 7
Re: this error drive me crazy
« Reply #6 on: July 29, 2015, 08:48:45 pm »
thanks, i will try it
Logged

bylaardt

  • Sr. Member
  • ****
  • Posts: 309
Re: this error drive me crazy
« Reply #7 on: July 29, 2015, 08:53:37 pm »
@howardpc: you are right, my bad.
Logged

nestork

  • New member
  • *
  • Posts: 7
Re: this error drive me crazy
« Reply #8 on: July 30, 2015, 02:02:10 am »
I modified by the Proposed code and the problem is not solved . the problem may be in the download as it occurs in 2 pcs at the same time
Logged

nestork

  • New member
  • *
  • Posts: 7
Re: this error drive me crazy
« Reply #9 on: July 30, 2015, 02:09:29 am »
compiling lazarus give this error: (http://www.subeimagenes.com/thumb/e-1-1392776.GIF) Subido en subir imagenes
Logged

bylaardt

  • Sr. Member
  • ****
  • Posts: 309
Re: this error drive me crazy
« Reply #10 on: July 30, 2015, 03:09:14 am »
this error comes from unfreed allocate memory:
you forgot ArrayDatos.free;
Logged

nestork

  • New member
  • *
  • Posts: 7
Re: this error drive me crazy
« Reply #11 on: August 01, 2015, 03:44:01 pm »
i solve the error making a new leerdatos method. i think that error is a bug of compiler mybe
Logged
Pages: [1]
« previous next »
 

TinyPortal © 2005-2018