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
Robert BecskeiAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
Robert BecskeiConnect With a Mentor Author Commented:
So the final and working solution is :

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;
    // stored procedure threaded
    spTWebLog : TADOStoredProc;
    spTRack : TADOStoredProc;
    spTHist : TADOStoredProc;
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);

            myConnect := TADOConnection.Create(nil);

            try
              myConnect.Provider := 'SQLOLEDB.1';
              myConnect.LoginPrompt:=false;
              myConnect.ConnectionString:= 'FILE NAME='+ExtractFilePath(Application.ExeName)+'\teutodb.udl';
              myConnect.Connected:=true;

              Qry := TADOQuery.Create(nil);
                try
                  Qry.Connection:=myConnect;
                  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 *************************************
                      spTWebLog := TADOStoredProc.Create(nil);
                      try
                        spTWebLog.Connection:=myConnect;
                        spTWebLog.CursorLocation:= clUseServer;
                        spTWebLog.ProcedureName:='spLadelisten_WebserverLog;1';
                        spTWebLog.Parameters.Refresh;


                        spTWebLog.Parameters.ParamValues['@OP']:='-'; // is not used
                        spTWebLog.Parameters.ParamValues['@ID']:=0; // is not used
                        spTWebLog.Parameters.ParamValues['@Kuid']:=strtoint(kuid);
                        spTWebLog.Parameters.ParamValues['@Kemail']:=email;
                        spTWebLog.Parameters.ParamValues['@Gestellname']:=gestellname;
                        spTWebLog.Parameters.ParamValues['@ClientIP']:=ARequestInfo.RemoteIP;
                        spTWebLog.Parameters.ParamValues['@ClientURL']:=ARequestInfo.URI;
                        spTWebLog.Parameters.ParamValues['@ClientAgent']:=ARequestInfo.UserAgent;
                        spTWebLog.Parameters.ParamValues['@Type']:=0;
                        spTWebLog.Parameters.ParamValues['@RequestDate']:=date+time;
                        spTWebLog.ExecProc;

                      finally
                        spTWebLog.Free;
                      end;
                      // ****************************  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
                      spTRack := TADOStoredProc.Create(nil);
                      try
                        spTRack.Connection:=myConnect;
                        spTRack.CursorLocation:= clUseServer;
                        spTRack.ProcedureName:='spLadelisten_GestellStammKopf;1';
                        spTRack.Parameters.Refresh;

                        spTRack.Parameters.ParamValues['@OP']:='WEBMARK';
                        spTRack.Parameters.ParamValues['@Free']:=1;
                        spTRack.Parameters.ParamValues['@FreeDate']:=date+time;
                        spTRack.Parameters.ParamValues['@Gestellname']:=gestellname;
                        // even thou I dont use them I must specify them ... otherwise error
                        spTRack.Parameters.ParamValues['@ID']:=0;
                        spTRack.Parameters.ParamValues['@Typ']:=0;
                        spTRack.Parameters.ParamValues['@MIX']:=0;
                        spTRack.Parameters.ParamValues['@Outside']:=0;
                        spTRack.Parameters.ParamValues['@Werk']:=0;
                        spTRack.Parameters.ParamValues['@Planned']:=0;
                        spTRack.Parameters.ParamValues['@PlannedLieferschein']:=0;
                        spTRack.Parameters.ParamValues['@PlannedBy']:=0;
                        spTRack.Parameters.ParamValues['@PlannedDate']:=0;
                        spTRack.Parameters.ParamValues['@Extern']:=0;
                        spTRack.Parameters.ParamValues['@OwnerID']:=0;
                        spTRack.Parameters.ParamValues['@Construction']:=0;
                        spTRack.Parameters.ParamValues['@BackID']:=0;
                        spTRack.ExecProc;

                      finally
                        spTRack.Free;
                      end;

                      // we also insert an entry into the History of the Rack
                      spTHist := TADOStoredProc.Create(nil);
                      try
                        spTHist.Connection:=myConnect;
                        spTHist.CursorLocation:= clUseServer;
                        spTHist.ProcedureName:='spLadelisten_GestellStammHIST;1';
                        spTHist.Parameters.Refresh;

                        spTHist.Parameters.ParamByName('@OP').Value:='INS';
                        spTHist.Parameters.ParamByName('@Kuid').Value:=strtoint(kuid);
                        spTHist.Parameters.ParamByName('@Kunde').Value:=Qry.FieldByName('Kunde').Value;
                        spTHist.Parameters.ParamByName('@Adresse').Value:=Qry.FieldByName('Adresse').Value;
                        spTHist.Parameters.ParamByName('@Ort').Value:=Qry.FieldByName('Ort').Value;
                        spTHist.Parameters.ParamByName('@Plz').Value:=Qry.FieldByName('Plz').Value;
                        spTHist.Parameters.ParamByName('@Land').Value:=Qry.FieldByName('Land').Value;
                        spTHist.Parameters.ParamByName('@Lieferschein').Value:=Qry.FieldByName('Lieferschein').Value;
                        spTHist.Parameters.ParamByName('@LKW').Value:='';
                        spTHist.Parameters.ParamByName('@OR_TOUR').Value:='';
                        spTHist.Parameters.ParamByName('@Liefertag').Value:='1899-01-01';
                        spTHist.Parameters.ParamByName('@Modifier').Value:='[KUNDE]';
                        spTHist.Parameters.ParamByName('@ModifyDate').Value:=date+time;
                        spTHist.Parameters.ParamByName('@gestellname').Value:=gestellname;
                        spTHist.Parameters.ParamByName('@Fehlergrund').Value:='';
                        spTHist.Parameters.ParamByName('@Direction').Value:=0;
                        spTHist.Parameters.ParamByName('@PlannedFailed').Value:=0;
                        spTHist.Parameters.ParamByName('@Reset').Value:=0;
                        spTHist.Parameters.ParamByName('@Construction').Value:=0;
                        spTHist.Parameters.ParamByName('@Computer').Value:='Transport XLR Mini Webserver';
                        // even thou I dont use them I must specify them ... otherwise error
                        spTHist.Parameters.ParamByName('@ID').Value:=0;
                        spTHist.ExecProc

                      finally
                        spTHist.Free;
                      end;
                    end
                  else
                    begin
                      // ****************************  LOG *************************************
                      spTWebLog := TADOStoredProc.Create(nil);
                      try
                        spTWebLog.Connection:=myConnect;
                        spTWebLog.CursorLocation:= clUseServer;
                        spTWebLog.ProcedureName:='spLadelisten_WebserverLog;1';
                        spTWebLog.Parameters.Refresh;


                        spTWebLog.Parameters.ParamValues['@OP']:='-'; // is not used
                        spTWebLog.Parameters.ParamValues['@ID']:=0; // is not used
                        spTWebLog.Parameters.ParamValues['@Kuid']:=strtoint(kuid);
                        spTWebLog.Parameters.ParamValues['@Kemail']:=email;
                        spTWebLog.Parameters.ParamValues['@Gestellname']:=gestellname;
                        spTWebLog.Parameters.ParamValues['@ClientIP']:=ARequestInfo.RemoteIP;
                        spTWebLog.Parameters.ParamValues['@ClientURL']:=ARequestInfo.URI;
                        spTWebLog.Parameters.ParamValues['@ClientAgent']:=ARequestInfo.UserAgent;
                        spTWebLog.Parameters.ParamValues['@Type']:=1;
                        spTWebLog.Parameters.ParamValues['@RequestDate']:=date+time;
                        spTWebLog.ExecProc;

                      finally
                        spTWebLog.Free;
                      end;

                      // ****************************  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;
                end;
            finally
              myConnect.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;

Open in new window

0
 
Geert GruwezOracle dbaCommented:
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
0
 
Robert BecskeiAuthor Commented:
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;
0
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Robert BecskeiAuthor Commented:
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.
0
 
Geert GruwezConnect With a Mentor Oracle dbaCommented:
well yes, writing a webserver is like programming in threads
with that there is no common stuff except constants

i thought it odd, that i didn't see any query.create or session.create
but since it was only a piece of the code, assumed you created this somewhere else
didn't  think you used 1 query or adoconnection for all url requests
0
 
Geert GruwezOracle dbaCommented:
um ... you have a memory leak when inputstring.count <> 3

:)
0
 
Geert GruwezOracle dbaCommented:
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

0
 
Robert BecskeiAuthor Commented:
Hard Work... Google ... Trial and Error
0
All Courses

From novice to tech pro — start learning today.