Solved

Delphi , Indy , AdoQuery / AdoStoredProcedure Thread

Posted on 2016-11-23
8
19 Views
Last Modified: 2016-11-28
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
0
Comment
Question by:Robert Becskei
  • 4
  • 4
8 Comments
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 41898769
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
 

Author Comment

by:Robert Becskei
ID: 41898926
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
 

Author Comment

by:Robert Becskei
ID: 41898930
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
 
LVL 37

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 500 total points
ID: 41899030
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Accepted Solution

by:
Robert Becskei earned 0 total points
ID: 41899214
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
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 41899314
um ... you have a memory leak when inputstring.count <> 3

:)
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 41899321
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
 

Author Closing Comment

by:Robert Becskei
ID: 41903945
Hard Work... Google ... Trial and Error
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
Along with being a a promotional video for my three-day Annielytics Dashboard Seminor, this Micro Tutorial is an intro to Google Analytics API data.
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, just open a new email message. In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…

864 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

25 Experts available now in Live!

Get 1:1 Help Now