Link to home
Start Free TrialLog in
Avatar of Robert Becskei
Robert Becskei

asked on

Delphi , Indy , AdoQuery / AdoStoredProcedure Thread

Hello Everyone , I am trying to create a small Webserver for internal usage . It is basicaly done and works wonderfully until a do a bit of stress testing on it . ( Firefox , Url : http://192.168.88.46:666/8231,12518,xxxx@yyyyy.com , and keep pressing F5 )

This is the part where I do the data processing with indy :

procedure TMain.IdHTTPServer1CommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var gestellname , kuid , email : string;
    inputstring : TStringList;
    temp : string;
    // only used to check if kuid is valid
    tempKuid , tempCode : integer;
begin
  temp:=ARequestInfo.URI;
  delete(temp,1,1);

  inputstring := TStringList.Create;
  inputstring.CommaText := temp;

  // ado threaded
  CoInitialize(nil); //CoInitialize was not called

  if inputstring.Count = 3 then
    begin
      gestellname:=inputstring[0];
      kuid:=inputstring[1];
      email:=inputstring[2];
      inputstring.Free;

      val(kuid,tempKuid,tempCode);

      if (length(gestellname) <= 50) and (length(kuid) <= 10) and (length(email) <= 50) and (tempCode = 0) then
        begin
          ResultQuery.ConnectionString:='FILE NAME='+ExtractFilePath(Application.ExeName)+'\teutodb.udl';
          ResultQuery.CursorLocation:= clUseServer;
          ResultQuery.CursorType:= ctOpenForwardOnly;

          if ResultQuery.Active then ResultQuery.Close;
          ResultQuery.Parameters.ParamByName('Gestellname').Value:=gestellname;
          ResultQuery.Parameters.ParamByName('kuid').Value:=strtoint(kuid);
          ResultQuery.Parameters.ParamByName('Gestell').Value:=email;
          ResultQuery.Open;

          if ResultQuery.RecordCount <> 0 then
            begin
              // ****************************  LOG *************************************
              spWebLog.ConnectionString:='FILE NAME='+ExtractFilePath(Application.ExeName)+'\teutodb.udl';
              spWebLog.CursorLocation := clUseServer;

              spWebLog.Parameters.ParamValues['@Kuid']:=strtoint(kuid);
              spWebLog.Parameters.ParamValues['@Kemail']:=email;
              spWebLog.Parameters.ParamValues['@Gestellname']:=gestellname;
              spWebLog.Parameters.ParamValues['@ClientIP']:=ARequestInfo.RemoteIP;
              spWebLog.Parameters.ParamValues['@ClientURL']:=ARequestInfo.URI;
              spWebLog.Parameters.ParamValues['@ClientAgent']:=ARequestInfo.UserAgent;
              spWebLog.Parameters.ParamValues['@Type']:=0;
              spWebLog.Parameters.ParamValues['@RequestDate']:=date+time;
              spWebLog.ExecProc;
              // ****************************  LOG *************************************

              AResponseInfo.ContentText := '<html><head><title>Transport XLR - Mini Webserver</title></head>' +
                '<body>Sehr geehrte Kunde,' +
                '<br />' +
                '<br />' +
                '<br />---------------------------------------------------------------------------------------' +
                '<br /><b>Gestellname:</b> ' + gestellname +
                '<br /><b>Kunde Nr.:</b> ' + kuid +  ' ('+ResultQueryKunde.Value+') ' +
                '<br /><b>E-Mail:</b> ' + email +
                '<br />---------------------------------------------------------------------------------------' +
                '<br />' +
                '<br />' +
                '<br />Gestell '+gestellname+' Freigemeldet! Vielen Dank für Ihre Unterstützung! ' +
                '<br />' +
                '<br />' +
                '<br />Mit Freudlichem Grüßen ' +
                '<br />Transport XLR ' +
                '<br />' +
                '</body></html>';

              // we mark the Rack free in our Database
              spRack.ConnectionString:='FILE NAME='+ExtractFilePath(Application.ExeName)+'\teutodb.udl';
              spRack.CursorLocation := clUseServer;

              spRack.Parameters.ParamValues['@OP']:='WEBMARK';
              spRack.Parameters.ParamValues['@Free']:=1;
              spRack.Parameters.ParamValues['@FreeDate']:=date+time;
              spRack.Parameters.ParamValues['@Gestellname']:=gestellname;
              spRack.ExecProc;

              // we also insert an entry into the History of the Rack
              spHist.ConnectionString:='FILE NAME='+ExtractFilePath(Application.ExeName)+'\teutodb.udl';
              spHist.CursorLocation := clUseServer;

              spHist.Parameters.ParamByName('@OP').Value:='INS';
              spHist.Parameters.ParamByName('@Kuid').Value:=strtoint(kuid);
              spHist.Parameters.ParamByName('@Kunde').Value:=ResultQueryKunde.Value;
              spHist.Parameters.ParamByName('@Adresse').Value:=ResultQueryAdresse.Value;
              spHist.Parameters.ParamByName('@Ort').Value:=ResultQueryOrt.Value;
              spHist.Parameters.ParamByName('@Plz').Value:=ResultQueryPlz.Value;
              spHist.Parameters.ParamByName('@Land').Value:=ResultQueryLand.Value;
              spHist.Parameters.ParamByName('@Lieferschein').Value:=ResultQueryLieferschein.Value;
              spHist.Parameters.ParamByName('@LKW').Value:='';
              spHist.Parameters.ParamByName('@OR_TOUR').Value:='';
              spHist.Parameters.ParamByName('@Liefertag').Value:='1899-01-01';
              spHist.Parameters.ParamByName('@Modifier').Value:='[KUNDE]';
              spHist.Parameters.ParamByName('@ModifyDate').Value:=date+time;
              spHist.Parameters.ParamByName('@gestellname').Value:=gestellname;
              spHist.Parameters.ParamByName('@Fehlergrund').Value:='';
              spHist.Parameters.ParamByName('@Direction').Value:=0;
              spHist.Parameters.ParamByName('@PlannedFailed').Value:=0;
              spHist.Parameters.ParamByName('@Reset').Value:=0;
              spHist.Parameters.ParamByName('@Construction').Value:=0;
              spHist.Parameters.ParamByName('@Computer').Value:='Transport XLR Mini Webserver';
              spHist.ExecProc
            end
          else
            begin
              // ****************************  LOG *************************************
              spWebLog.ConnectionString:='FILE NAME='+ExtractFilePath(Application.ExeName)+'\teutodb.udl';
              spWebLog.CursorLocation := clUseServer;

              spWebLog.Parameters.ParamValues['@Kuid']:=strtoint(kuid);
              spWebLog.Parameters.ParamValues['@Kemail']:=email;
              spWebLog.Parameters.ParamValues['@Gestellname']:=gestellname;
              spWebLog.Parameters.ParamValues['@ClientIP']:=ARequestInfo.RemoteIP;
              spWebLog.Parameters.ParamValues['@ClientURL']:=ARequestInfo.URI;
              spWebLog.Parameters.ParamValues['@ClientAgent']:=ARequestInfo.UserAgent;
              spWebLog.Parameters.ParamValues['@Type']:=1;
              spWebLog.Parameters.ParamValues['@RequestDate']:=date+time;
              spWebLog.ExecProc;
              // ****************************  LOG *************************************
              AResponseInfo.ContentText := '<html><head><title>Transport XLR - Mini Webserver</title></head>' +
                '<body>Sehr geehrte Kunde,' +
                '<br />' +
                '<br />' +
                '<br />---------------------------------------------------------------------------------------' +
                '<br />Die von Ihnen eingegebene Gestellnummer '+gestellname+' ist nicht länger Gültig ' +
                '<br />---------------------------------------------------------------------------------------' +
                '<br />' +
                '<br />' +
                '<br />Mit Freudlichem Grüßen ' +
                '<br />Transport XLR ' +
                '<br />' +
                '</body></html>';
            end;
        end
      else
        begin
          // ****************************  LOG *************************************

          // ****************************  LOG *************************************
          AResponseInfo.ContentText := '<html><head><title>Transport XLR - Mini Webserver</title></head>' +
            '<body>Sehr geehrte Kunde,' +
            '<br />' +
            '<br />' +
            '<br />---------------------------------------------------------------------------------------' +
            '<br /><b>Eingabe Fehler</b> ' +
            '<br />---------------------------------------------------------------------------------------' +
            '<br />' +
            '<br />' +
            '<br />Mit Freudlichem Grüßen ' +
            '<br />Transport XLR ' +
            '<br />' +
            '</body></html>';
        end;
    end
  else
    begin
          // ****************************  LOG *************************************

          // ****************************  LOG *************************************
          AResponseInfo.ContentText := '<html><head><title>Transport XLR - Mini Webserver</title></head>' +
            '<body>Sehr geehrte Kunde,' +
            '<br />' +
            '<br />' +
            '<br />---------------------------------------------------------------------------------------' +
            '<br /><b>Eingabe Fehler</b> ' +
            '<br />---------------------------------------------------------------------------------------' +
            '<br />' +
            '<br />' +
            '<br />Mit Freudlichem Grüßen ' +
            '<br />Transport XLR ' +
            '<br />' +
            '</body></html>';
    end;

  CoUninitialize();

end;

The problem is when I keep pressing the F5 without releasing it , after a while I get the error :

The operation can not be processed while an asynchronous command is being executed
Avatar of Geert G
Geert G
Flag of Belgium image

EE has this same problem some times
the return you get from EE: too many requests

have you ever seen a try finally construction ? this helps to avoid memory leaks in case of errors
inputstring := TStringList.Create;
try
  inputstring.CommaText := temp;
  // ... 
finally
  inputstring.Free;
end;

Open in new window


i assume this is a built in mechanism in indy to prevent too many requests
Avatar of Robert Becskei
Robert Becskei

ASKER

Hi Geert,

Thank you but highly unlikely ... if I send the following url to the Webserver : http://192.168.88.46:666/
then the Static Webpage is executed. If I keep pressing the key for 30 minutes , did it just now. I still wont get an error .
The error comes from the AdoQuery , if I comment everything out and just leave the AdoQuery I get the error. Meanwhile I've altered the code a bit. I created the Query on the fly .

    if inputstring.Count = 3 then
      begin
          // query and later stored procedures
      end
    else
      begin
         // shows static webpage
      end;

Here the complete source again , altered :

procedure TMain.IdHTTPServer1CommandGet(AContext: TIdContext;
  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var gestellname , kuid , email : string;
    inputstring : TStringList;
    temp : string;
    // only used to check if kuid is valid
    tempKuid , tempCode : integer;

    // ado connection threaded
    Qry : TADOQuery;
    myConnect : TADOConnection;
begin
  temp:=ARequestInfo.URI;
  delete(temp,1,1);

  inputstring := TStringList.Create;
  inputstring.CommaText := temp;

    if inputstring.Count = 3 then
      begin
        gestellname:=inputstring[0];
        kuid:=inputstring[1];
        email:=inputstring[2];
        inputstring.Free;

        val(kuid,tempKuid,tempCode);

        if (length(gestellname) <= 50) and (length(kuid) <= 10) and (length(email) <= 50) and (tempCode = 0) then
          begin
            CoInitialize(nil);
            Qry := TADOQuery.Create(nil);
            try
              Qry.ConnectionString:='FILE NAME='+ExtractFilePath(Application.ExeName)+'\teutodb.udl';
              Qry.CursorLocation:= clUseServer;
              Qry.LockType := ltReadOnly;

              if Qry.Active then Qry.Close;
              Qry.SQL.Clear;

              Qry.SQL.Add('select GestellName,Typ,Kuid,Kunde,Adresse,Ort,PLZ,Land,Werk,Glaeser,Lieferschein,LKW,OR_TOUR,');
              Qry.SQL.Add('convert(varchar,cast(Liefertag as Date),104) as Liefertag,c2.Modifier,c2.ModifyDate,c2.Computer,');
              Qry.SQL.Add('DATEDIFF(day,Liefertag,getdate()) as Tage,Planned,PlannedLieferschein,Plannedby,convert(varchar,cast(PlannedDate as Date),104) as PlannedDate,PlannedFailed,');
              Qry.SQL.Add('Extern,c3.Name,c1.OwnerID,c1.Construction,c4.Gestell as Email');
              Qry.SQL.Add('from Ladelisten_GestellStammKopf c1');
              Qry.SQL.Add('inner join LadeListen_GestellStammPos c2 on c1.ID=c2.HeadID');
              Qry.SQL.Add('left join LadeListen_GestellEigentuemer c3 on c1.OwnerID=c3.ID');
              Qry.SQL.Add('left join LadeListen_GestellKunden c4 on c2.Kuid=c4.HeadID');
              Qry.SQL.Add('where MIX=1 and OutSide=1 and Planned=0 and Free=0');
              Qry.SQL.Add('and Gestellname='+Gestellname+' and Kuid='+kuid+' and Gestell='+quotedstr(email));
              Qry.SQL.Add('order by DATEDIFF(day,Liefertag,getdate()),Gestellname asc');

              Qry.Open;

              if Qry.RecordCount <> 0 then
                begin
                  // ****************************  LOG *************************************
                  spWebLog.ConnectionString:='FILE NAME='+ExtractFilePath(Application.ExeName)+'\teutodb.udl';
                  spWebLog.CursorLocation := clUseServer;

                  spWebLog.Parameters.ParamValues['@Kuid']:=strtoint(kuid);
                  spWebLog.Parameters.ParamValues['@Kemail']:=email;
                  spWebLog.Parameters.ParamValues['@Gestellname']:=gestellname;
                  spWebLog.Parameters.ParamValues['@ClientIP']:=ARequestInfo.RemoteIP;
                  spWebLog.Parameters.ParamValues['@ClientURL']:=ARequestInfo.URI;
                  spWebLog.Parameters.ParamValues['@ClientAgent']:=ARequestInfo.UserAgent;
                  spWebLog.Parameters.ParamValues['@Type']:=0;
                  spWebLog.Parameters.ParamValues['@RequestDate']:=date+time;
                  spWebLog.ExecProc;
                  // ****************************  LOG *************************************

                  AResponseInfo.ContentText := '<html><head><title>Transport XLR - Mini Webserver</title></head>' +
                    '<body>Sehr geehrte Kunde,' +
                    '<br />' +
                    '<br />' +
                    '<br />---------------------------------------------------------------------------------------' +
                    '<br /><b>Gestellname:</b> ' + gestellname +
                    '<br /><b>Kunde Nr.:</b> ' + kuid +  ' ('+Qry.FieldByName('Kunde').Value+') ' +
                    '<br /><b>E-Mail:</b> ' + email +
                    '<br />---------------------------------------------------------------------------------------' +
                    '<br />' +
                    '<br />' +
                    '<br />Gestell '+gestellname+' Freigemeldet! Vielen Dank für Ihre Unterstützung! ' +
                    '<br />' +
                    '<br />' +
                    '<br />Mit Freudlichem Grüßen ' +
                    '<br />Transport XLR ' +
                    '<br />' +
                    '</body></html>';

                  // we mark the Rack free in our Database
                  spRack.ConnectionString:='FILE NAME='+ExtractFilePath(Application.ExeName)+'\teutodb.udl';
                  spRack.CursorLocation := clUseServer;

                  spRack.Parameters.ParamValues['@OP']:='WEBMARK';
                  spRack.Parameters.ParamValues['@Free']:=1;
                  spRack.Parameters.ParamValues['@FreeDate']:=date+time;
                  spRack.Parameters.ParamValues['@Gestellname']:=gestellname;
                  spRack.ExecProc;

                  // we also insert an entry into the History of the Rack
                  spHist.ConnectionString:='FILE NAME='+ExtractFilePath(Application.ExeName)+'\teutodb.udl';
                  spHist.CursorLocation := clUseServer;

                  spHist.Parameters.ParamByName('@OP').Value:='INS';
                  spHist.Parameters.ParamByName('@Kuid').Value:=strtoint(kuid);
                  spHist.Parameters.ParamByName('@Kunde').Value:=Qry.FieldByName('Kunde').Value;
                  spHist.Parameters.ParamByName('@Adresse').Value:=Qry.FieldByName('Adresse').Value;
                  spHist.Parameters.ParamByName('@Ort').Value:=Qry.FieldByName('Ort').Value;
                  spHist.Parameters.ParamByName('@Plz').Value:=Qry.FieldByName('Plz').Value;
                  spHist.Parameters.ParamByName('@Land').Value:=Qry.FieldByName('Land').Value;
                  spHist.Parameters.ParamByName('@Lieferschein').Value:=Qry.FieldByName('Lieferschein').Value;
                  spHist.Parameters.ParamByName('@LKW').Value:='';
                  spHist.Parameters.ParamByName('@OR_TOUR').Value:='';
                  spHist.Parameters.ParamByName('@Liefertag').Value:='1899-01-01';
                  spHist.Parameters.ParamByName('@Modifier').Value:='[KUNDE]';
                  spHist.Parameters.ParamByName('@ModifyDate').Value:=date+time;
                  spHist.Parameters.ParamByName('@gestellname').Value:=gestellname;
                  spHist.Parameters.ParamByName('@Fehlergrund').Value:='';
                  spHist.Parameters.ParamByName('@Direction').Value:=0;
                  spHist.Parameters.ParamByName('@PlannedFailed').Value:=0;
                  spHist.Parameters.ParamByName('@Reset').Value:=0;
                  spHist.Parameters.ParamByName('@Construction').Value:=0;
                  spHist.Parameters.ParamByName('@Computer').Value:='Transport XLR Mini Webserver';
                  spHist.ExecProc
                end
              else
                begin
                  // ****************************  LOG *************************************
                  spWebLog.ConnectionString:='FILE NAME='+ExtractFilePath(Application.ExeName)+'\teutodb.udl';
                  spWebLog.CursorLocation := clUseServer;

                  spWebLog.Parameters.ParamValues['@Kuid']:=strtoint(kuid);
                  spWebLog.Parameters.ParamValues['@Kemail']:=email;
                  spWebLog.Parameters.ParamValues['@Gestellname']:=gestellname;
                  spWebLog.Parameters.ParamValues['@ClientIP']:=ARequestInfo.RemoteIP;
                  spWebLog.Parameters.ParamValues['@ClientURL']:=ARequestInfo.URI;
                  spWebLog.Parameters.ParamValues['@ClientAgent']:=ARequestInfo.UserAgent;
                  spWebLog.Parameters.ParamValues['@Type']:=1;
                  spWebLog.Parameters.ParamValues['@RequestDate']:=date+time;
                  spWebLog.ExecProc;
                  // ****************************  LOG *************************************
                  AResponseInfo.ContentText := '<html><head><title>Transport XLR - Mini Webserver</title></head>' +
                    '<body>Sehr geehrte Kunde,' +
                    '<br />' +
                    '<br />' +
                    '<br />---------------------------------------------------------------------------------------' +
                    '<br />Die von Ihnen eingegebene Gestellnummer '+gestellname+' ist nicht länger Gültig ' +
                    '<br />Möglicheweise ist die Gestell von Ihnen abgeholt oder Sie haben es bereits Freigemeldet. '  +
                    '<br />Falls nicht bitte schreiben Sie ein e-mail an : gestelle@teutoglas.de '  +
                    '<br />---------------------------------------------------------------------------------------' +
                    '<br />' +
                    '<br />' +
                    '<br />Mit Freudlichem Grüßen ' +
                    '<br />Transport XLR ' +
                    '<br />' +
                    '</body></html>';
              end;
            finally
              Qry.Free;
              CoUninitialize();
            end;
          end
        else
          begin
            // ****************************  LOG *************************************

            // ****************************  LOG *************************************
            AResponseInfo.ContentText := '<html><head><title>Transport XLR - Mini Webserver</title></head>' +
              '<body>Sehr geehrte Kunde,' +
              '<br />' +
              '<br />' +
              '<br />---------------------------------------------------------------------------------------' +
              '<br /><b>Eingabe Fehler</b> ' +
              '<br />---------------------------------------------------------------------------------------' +
              '<br />' +
              '<br />' +
              '<br />Mit Freudlichem Grüßen ' +
              '<br />Transport XLR ' +
              '<br />' +
              '</body></html>';
          end;
      end
    else
      begin
            // ****************************  LOG *************************************

            // ****************************  LOG *************************************
            AResponseInfo.ContentText := '<html><head><title>Transport XLR - Mini Webserver</title></head>' +
              '<body>Sehr geehrte Kunde,' +
              '<br />' +
              '<br />' +
              '<br />---------------------------------------------------------------------------------------' +
              '<br /><b>Eingabe Fehler</b> ' +
              '<br />---------------------------------------------------------------------------------------' +
              '<br />' +
              '<br />' +
              '<br />Mit Freudlichem Grüßen ' +
              '<br />Transport XLR ' +
              '<br />' +
              '</body></html>';
      end;
end;
So update, now I am creating the adoconnection and the query on the fly...
I just tried a 5 min session (which till now was impossible without any errors) F5 on two computers pressed.
The website refreshed like crazy... no errors nowhere...
I commented out the stored procedures for testing....

SO it looks like the Query is finally ok like this...

I will probably need to dynamically create the stored procedure as well... or else it will not work.

I will report back later.
SOLUTION
Avatar of Geert G
Geert G
Flag of Belgium image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
um ... you have a memory leak when inputstring.count <> 3

:)
it would take a while until the memory leaks hits bottom (usually at 1.8gb memory usage if you compile in 32-bit)


  process: boolean;
begin
  process := false;
  inputstring := TStringList.Create;
  try
    inputstring.CommaText := temp;
    if inputstring.Count = 3 then
    begin
      process := true;
      gestellname:=inputstring[0];
      kuid:=inputstring[1];
      email:=inputstring[2];
    end;
  finally
      inputstring.Free;
  end;

  if process then 
  begin
    // the rest

Open in new window

Hard Work... Google ... Trial and Error