How to implement long running queries on IdhttpServer? - delphi

What is good way to implement long running queries on IdHttpServer. I have written simple logic to do so, please advise suggest better way to achive the same as I'm struggling with its performance.
I am using D2010 and Indy 10.5.8 to achieve the goal, also suggest if we retrive values frequently from session will that be a resource intensive ?
procedure TForm1.ServerCommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
SessionObj : TSessionData;
begin
if ARequestInfo.Document = 'EXECUTEQUERY' then
begin
if not Assigned(ARequestInfo.Session.Content) then
begin
SessionObj := TSessionData.Create;
ARequestInfo.Session.Content.AddObject('U_SESSION', SessionObj);
SessionObj.RunLongQuery;
end;
end;
if ARequestInfo.Document = 'GETDATA' then
begin
SessionObj := TSessionData(ARequestInfo.Session.Content.Objects[ ARequestInfo.Session.Content.IndexOf('U_SESSION')]);
if SessionObj.GetQueryStat = Done then
begin
AResponseInfo.ContentStream.CopyFrom(SessionObj.GetMemStream, SessionObj.GetMemStream.Size);
SessionObj.GetMemStream.Clear;
AResponseInfo.ResponseNo := 200;
end else if SessionObj.GetQueryStat = Error then
AResponseInfo.ResponseNo := 500
else AResponseInfo.ResponseNo := 102;
end;
end;
procedure TForm1.ServerSessionEnd(Sender: TIdHTTPSession);
begin
TSessionData(Sender.Content.Objects[ Sender.Content.IndexOf('U_SESSION')]).Free;
end;
{ TProcessQuery }
constructor TProcessQuery.Create;
begin
myConn := TMyConnection.Create(nil);
myConn.LoginPrompt := False;
myConn.UserName := 'UserName';
myConn.Password := 'Password';
myConn.Server := 'Host';
myConn.Database := 'DBName';
myConn.Connected := True;
myQuery := TMyQuery.Create(nil);
myQuery.Unidirectional := True;
myQuery.Options.CreateConnection := False;
myQuery.Connection := myConn;
Fstat := None;
Fstream := TMemoryStream.Create;
end;
destructor TProcessQuery.Destroy;
begin
if Assigned(myConn) then begin
myConn.Close;
myConn.Disconnect;
FreeAndNil(myConn);
end;
end;
procedure TProcessQuery.ExecuteQuery;
begin
Status := Started;
myQuery.SQL.Text := '<Some Query>';
myQuery.Open;
try
try
while not myQuery.Eof do
begin
Status := Inprogress;
//Add to FStream which would be returned to user.
end;
except
on Exception do
Status := Error;
end;
finally
myQuery.Close;
end;
end;
{ TSessionData }
constructor TSessionData.Create;
begin
FProcessQuery := TProcessQuery.Create;
end;
function TSessionData.GetMemStream: TMemoryStream;
begin
result := FProcessQuery.Fstream;
end;
function TSessionData.GetQueryStat: TStatus;
begin
result := FProcessQuery.Status;
end;
procedure TSessionData.RunLongQuery;
begin
FProcessQuery.ExecuteQuery
end;

You are running the actual query in the context of ServerCommandGet(), so the client will not receive a reply until the query has finished. For what you are attempting, you need to move the query to its own thread and let ServerCommandGet() exit so the client gets a reply and can move on, thus freeing it to send subsequent GETDATA requests. In ServerSessionEnd(), you will have to terminate the query thread if it is still running, and free the TSessionData object.
There are some other problems with your code as well.
ServerCommandGet() is checking for not Assigned(ARequestInfo.Session.Content) and then calling ARequestInfo.Session.Content.AddObject() when ARequestInfo.Session.Contentis nil. I don't see any code that is creating the ARequestInfo.Session.Content object.
If the client issues multiple EXECUTEQUERY requests, you are storing them all in AResponseInfo.Session.Content using the same name, 'U_SESSION'. GETDATA will return the results of only the first query it finds, and ServerSessionEnd() only frees the first query it finds. So either give each query a unique name and send that back to the client so it can include it in GETDATA and make ServerSessionEnd() loop through the entire Sender.Content, or else do not allow multiple queries in the same HTTP session. If the client issues a new EXECUTEQUERY while a previous query is still active, kill the previous query before starting the new one.
When the client issues GETDATA, the code needs to take into account that the requested query may not exist, such as if it previously expired and was freed by ServerSessionEnd(). Also, if a query does exist and has finished, you are calling AResponseInfo.ContentStream.CopyFrom() but AResponseInfo.ContentStream is nil when ServerCommandGet() is called. You are responsible for providing your own ContentStream object. So either take ownership of TSessionData's memory stream and assign it as the AResponseInfo.ContentStream object, or else create a new TMemoryStream to copy into and then assign that as the AResponseInfo.ContentStream object. Either way, TIdHTTPServer will free the AResponseInfo.ContentStream after sending it to the client.

Related

Delphi service app crashes at a random time

I have a Delphi Service app. Indy TCP server and many clients (up to 50), ADO connection to Firebird and simply network exchange. App randomly crashes (may be workin 7 days, may be 1 hour) with next event (for example):
Имя сбойного приложения: rollcontrol.exe, версия: 1.1.20.2, метка времени: 0x60acd5f2
Имя сбойного модуля: ntdll.dll, версия: 6.3.9600.19678, метка времени: 0x5e82c0f7
Код исключения: 0xc0000005
Смещение ошибки: 0x00058def
Идентификатор сбойного процесса: 0x4178
or:
Имя сбойного приложения: rollcontrol.exe, версия: 1.1.1.9, метка времени: 0x607b239c
Имя сбойного модуля: msvcrt.dll, версия: 7.0.9600.16384, метка времени: 0x52158ff5
Код исключения: 0xc0000005
Смещение ошибки: 0x00009e80
All jobs in app makes in anonimius threads or in tcp/ip connections threads. All code in each thread executed in try except statments. There no memory leaks or growing threads count. The main code of service thread very simple:
procedure TRollControl_Svc.ServiceExecute(Sender: TService);
begin
while not Terminated do
try
ServiceThread.ProcessRequests(False);
ServiceThread.Sleep(100);
except
on e : exception do LogException('ServiceExecute', E);
end;
end;
How I can handled this exception and prevent app crash? How it possible to crash service thread with two simple lines of code?
Thanks
UPDATE: Example of connections to DB:
function TRollControl_Svc.GetNodeIdByIP(ip: string): integer;
Var
SQLConnection : TADOConnection;
SQLQuery : TADOQuery;
Thread : TThread;
fResult : integer;
begin
fResult := 0;
try
Thread := nil;
Thread := TThread.CreateAnonymousThread(
procedure
begin
try
SQLConnection := nil;
SQLQuery := nil;
CoInitialize(nil);
SQLConnection := TADOConnection.Create(nil);
SQLConnection.ConnectionString := 'Provider=MSDASQL.1;Password=' + Psw + ';Persist Security Info=True;User ID=' + Usr + ';Data Source=' + Srv ;
SQLConnection.LoginPrompt := false;
SQLQuery := TADOQuery.Create(nil);
SQLQuery.Connection := SQLConnection;
SQLQuery.LockType := ltReadOnly;
try SQLConnection.Open; except SQLConnection.Open; end;
SQLConnection.BeginTrans;
SQLQuery.Close;
SQLQuery.SQL.Text := 'select nodes.* from nodes where nodes.ip = :ip';
SQLQuery.Parameters.ParamByName('ip').Value := ip;
try SQLQuery.Open; except SQLQuery.Open; end;
if SQLQuery.IsEmpty then exit;
fResult := SQLQuery.FieldByName('ID').AsInteger;
if SQLConnection.InTransaction then
SQLConnection.CommitTrans;
finally
TryFree(SQLQuery);
TryFree(SQLConnection);
CoUninitialize;
end;
end
);
Thread.FreeOnTerminate := false;
Thread.Start;
Thread.WaitFor;
finally
TryFree(Thread);
end;
result := fResult;
end;
Error Handling
This isn't an answer as to what is causing your problem, but I thought it probably wouldn't be clear in a comment.
In languages that support structured exception handling the language gives the programmer an opportunity to fail gracefully when things don't work. That's not how you are using it. From your example anonymous thread you have:
try SQLConnection.Open; except SQLConnection.Open; end;
So you are told that the connection can't be made and instead of responding to that situation you go ahead and attempt to connect again. There are lots of reasons why a connection may not work, some of those are transient so the attempt may work a little later but if you simply try doing it again without any pause it seems reasonable to expect it to fail again.
It's obviously important to catch errors, but you have to have appropriate failure paths.
I have no way of knowing if this is related to what's actually going wrong.
I found the reason. The problem was in the ADO source codes (Data.Win.ADODB.pas):
procedure RefreshFromOleDB;
var
I: Integer;
ParamCount: ULONG_PTR;
ParamInfo: PDBParamInfoArray;
NamesBuffer: POleStr;
Name: WideString;
Parameter: _Parameter;
Direction: ParameterDirectionEnum;
OLEDBCommand: ICommand;
OLEDBParameters: ICommandWithParameters;
CommandPrepare: ICommandPrepare;
begin
OLEDBCommand := (Command.CommandObject as ADOCommandConstruction).OLEDBCommand as ICommand;
OLEDBCommand.QueryInterface(ICommandWithParameters, OLEDBParameters);
OLEDBParameters.SetParameterInfo(0, nil, nil); // ----- Error here
if Assigned(OLEDBParameters) then
begin
ParamInfo := nil;
NamesBuffer := nil;
try
OLEDBCommand.QueryInterface(ICommandPrepare, CommandPrepare);
if Assigned(CommandPrepare) then CommandPrepare.Prepare(0);
if OLEDBParameters.GetParameterInfo(ParamCount, PDBPARAMINFO(ParamInfo), #NamesBuffer) = S_OK then
for I := 0 to ParamCount - 1 do//
begin
{ When no default name, fabricate one like ADO does }
if ParamInfo[I].pwszName = nil then
Name := 'Param' + IntToStr(I+1) else { Do not localize }
Name := ParamInfo[I].pwszName;
{ ADO maps DBTYPE_BYTES to adVarBinary }
if ParamInfo[I].wType = DBTYPE_BYTES then ParamInfo[I].wType := adVarBinary;
{ ADO maps DBTYPE_STR to adVarChar }
if ParamInfo[I].wType = DBTYPE_STR then ParamInfo[I].wType := adVarChar;
{ ADO maps DBTYPE_WSTR to adVarWChar }
if ParamInfo[I].wType = DBTYPE_WSTR then ParamInfo[I].wType := adVarWChar;
Direction := ParamInfo[I].dwFlags and $F;
{ Verify that the Direction is initialized }
if Direction = adParamUnknown then Direction := adParamInput;
Parameter := Command.CommandObject.CreateParameter(Name, ParamInfo[I].wType, Direction, ParamInfo[I].ulParamSize, EmptyParam);
Parameter.Precision := ParamInfo[I].bPrecision;
Parameter.NumericScale := ParamInfo[I].bScale;
//if ParamInfo[I].dwFlags and $FFFFFFF0 <= adParamSigned + adParamNullable + adParamLong then
Parameter.Attributes := ParamInfo[I].dwFlags and $FFFFFFF0; { Mask out Input/Output flags }
AddParameter.FParameter := Parameter;
end;
finally
if Assigned(CommandPrepare) then CommandPrepare.Unprepare;
if (ParamInfo <> nil) then GlobalMalloc.Free(ParamInfo);
if (NamesBuffer <> nil) then GlobalMalloc.Free(NamesBuffer);
end;
end;
end;
Line
OLEDBParameters.SetParameterInfo(0, nil, nil)
executed before
if Assigned(OLEDBParameters)
I moved this line after checking on nil and all working fine
I managed to isolate the problem. Errors occur periodically when working with ADO. If I try to use TADOQuery objects again, the application more susceptible to crashes. What I've done:
System.NeverSleepOnMMThreadContention: = false;
Significantly reduces errors when working with ADO
All uses of TADOQuery are single use.
For example it was:
for ii := 0 to SettingsXML.Root.NamedItem['sql_clear_base'].NamedItem['XML'].Count - 1 do
begin
try
SQLQuery.Close;
SQLQuery.SQL.Text := SettingsXML.Root.NamedItem['sql_clear_base'].NamedItem['XML'][ii].AsString;
SQLQuery.ExecSQL;
except
on e : exception do LogException('ClearBase', '', E);
end;
end;
Became:
for ii := 0 to SettingsXML.Root.NamedItem['sql_clear_base'].NamedItem['XML'].Count - 1 do
begin
SQLQuery := nil;
try
SQLQuery := TADOQuery.Create(nil);
SQLQuery.Connection := SQLConnection;
try
SQLQuery.Close;
SQLQuery.SQL.Text := SettingsXML.Root.NamedItem['sql_clear_base'].NamedItem['XML'][ii].AsString;
SQLQuery.ExecSQL;
except
on e : exception do LogException('ClearBase', '', E);
end;
finally
TryFree(SQLQuery);
end;
end;
I make self-control:
main procces started as windows service (process A)
process A starts a copy of itself as B
one per minutes A check if B alive and restart if not
one per minutes B check if A alive and restart if not
check - simple TCP packet and answer
For example:
TThread.CreateAnonymousThread(
procedure
var tcpClient : TidTCPClient;
begin
tcpClient := nil;
LastKeepAlive := Date + Time;
while ServerMode do
begin
try
if not Assigned(tcpClient) then
begin
tcpClient := TIdTCPClient.Create(nil);
tcpClient.Host := '127.0.0.1';
tcpClient.Port := RollControl_Svc.TCPServer.Bindings[0].Port;
tcpClient.Connect;
tcpClient.IOHandler.ReadTimeout := 1000;
end;
tcpClient.IOHandler.Write(START_PACKET + #0 + END_PACKET);
tcpClient.IOHandler.ReadString(3);
LastKeepAlive := Date + Time;
except
TryFree(tcpClient);
end;
sleep(15 * 1000);
end;
end).Start;
TThread.CreateAnonymousThread(
procedure
Var Res: TRequestResult;
begin
while ServerMode do
begin
if Date + Time - LastKeepAlive > OneMinute then
begin
Res.Clear('', '');
Res.Nodes_ID := -1;
Res.Data_In := 'KeepAlive';
Res.Data_Out := 'Exception: ExitProcess(1)';
try
Log(Res, true);
finally
ExitProcess(1);
end;
end;
sleep(1000);
end;
end).Start;
P.S. Local tests never crashed applications. The program simply proceed a million requests (connect, request, disconnect), there are no memory leaks or failures. On several clients servers are crashed. In the future I want to port to Lazarus to use ODBC directly insteed ADO

What is real web-url for mORMot web-service?

Please help to understand about routing and web-url of web-service below.
type
TAirportService = class(TInterfacedObject, IAirportService)
public
procedure GetAirportDefinition(const AirPortID: integer; out Definition: TDTOAirportDefinition);
end;
procedure TAirportService.GetAirportDefinition(const AirPortID: integer;
out Definition: TDTOAirportDefinition);
begin
// create an object from static data
// (real application may use database and complex code to retrieve the values)
with Definition.Airport.Add do begin
Location := 'LAX';
Terminal := TRawUTF8DynArrayFrom(['terminalA', 'terminalB', 'terminalC']);
Gate := TRawUTF8DynArrayFrom(['gate1', 'gate2', 'gate3', 'gate4', 'gate5']);
BHS := 'Siemens';
DCS := 'Altiea';
end;
with Definition.Airline.Add do begin
CX := TRawUTF8DynArrayFrom(['B777', 'B737', 'A380', 'A320']);
QR := TRawUTF8DynArrayFrom(['A319', 'A380', 'B787']);
ET := '380';
SQ := 'A320';
end;
Definition.GroundHandler := TRawUTF8DynArrayFrom(['Swissport','SATS','Wings','TollData']);
end;
procedure StartWebService();
var
aModel: TSQLModel;
aDB: TSQLRestServer;
aServer: TSQLHttpServer;
begin
// set the logs level to only important events (reduce .log size)
TSQLLog.Family.Level := LOG_STACKTRACE+[sllInfo,sllServer];
// initialize the ORM data model
aModel := TSQLModel.Create([]);
try
// create a fast in-memory ORM server
aDB := TSQLRestServerFullMemory.Create(aModel,'test.json',false,false);
try
// register our TAirportServer implementation
// aDB.ServiceRegister(TServiceCalculator,[TypeInfo(ICalculatorXML)],sicShared);
aDB.ServiceRegister(TAirportService,[TypeInfo(IAirportService)],sicShared);
// launch the HTTP server
aServer := TSQLHttpServer.Create('8092', [aDB], '+', useHttpApiRegisteringURI);
try
aServer.AccessControlAllowOrigin := '*'; // allow cross-site AJAX queries
writeln('Background server is running'#10);
write('Press [Enter] to close the server.');
ConsoleWaitForEnterKey;
finally
aServer.Free;
end;
finally
aDB.Free;
end;
finally
aModel.Free;
end;
end;
I try to call follow web-urls:
http://localhost:8092/root/AirportService/GetAirportDefinition?AirPortID=1
http://localhost:8092/root/AirportService.GetAirportDefinition?AirPortID=1
http://localhost:8092/root/AirportService/GetAirportDefinition
http://localhost:8092/AirportService/GetAirportDefinition?AirPortID=1
http://localhost:8092/AirportService.GetAirportDefinition?AirPortID=1
http://localhost:8092/AirportService/GetAirportDefinition
but every time I get:
{
"errorCode":400,
"errorText":"Bad Request"
}
or Bad request
Where am I wrong?
A was wrong, really urls below works as needed:
http://localhost:8092/root/AirportService/GetAirportDefinition?AirPortID=1
http://localhost:8092/root/AirportService.GetAirportDefinition?AirPortID=1

How to properly start, working and finish a transaction?

I'm using MySQL, and I know that Nested Connection are not allowed - use "save points" for this - but I would like create a more generic code that could also be used with other DBMS.
So, I would like know how to properly start, working and finish a transaction in the code below?
Once ExampleDAO.Save() function could be used inside other function, like OtherExampleDAO.Save(), I need verify a transaction has been started before I try start a new one.
The lines with the verification if Assigned(dbTransaction) then always returns true, so how to properly verify if dbTransaction was instantiated?
function TExampleDAO.Save(const Example: TExample): Boolean;
var
dbxTransaction: TDBXTransaction;
begin
if Assigned(Example) then // prevents invalid object, like ExampleDAO.Save(nil);
begin
try
if (_connection.TransactionsSupported) AND
((not _connection.InTransaction) OR (_connection.MultipleTransactionsSupported)) then
begin
dbxTransaction := _connection.BeginTransaction(TDBXIsolations.ReadCommitted);
end;
try
// example
_sqlQuery.Close;
_sqlQuery.SQL.Clear;
_sqlQuery.SQL.Add('INSERT INTO example(a, b) '
+ 'VALUES(:a, :b)');
_sqlQuery.ParamByName('a').AsAnsiString := Example.A;
_sqlQuery.ParamByName('b').AsDateTime := Example.B;
_sqlQuery.ExecSQL(False);
// example info
_sqlQuery.Close;
_sqlQuery.SQL.Clear;
_sqlQuery.SQL.Add('INSERT INTO example_info(c, d) '
+ 'VALUES(:c, :d)');
_sqlQuery.ParamByName('c').AsInteger := Example.Info.C;
_sqlQuery.ParamByName('d').AsFloat := Example.Info.D;
_sqlQuery.ExecSQL(False);
if Assigned(dbxTransaction) then
_connection.CommitFreeAndNil(dbxTransaction);
Result := True;
except
on Exc:Exception do
begin
if Assigned(dbxTransaction) then
_connection.RollBackFreeAndNil(dbxTransaction);
raise Exc;
Result := False;
end;
end;
finally
if Assigned(dbxTransaction) then
FreeAndNil(dbxTransaction);
end;
end
else
begin
Result := False;
end;
end;
You need to properly initialize dbxTransaction to nil at the start of your function. Local variables in Delphi (on the Win32 platform, at least) are not initialized until a value is assigned to them, meaning that the content is unknown. Passing any value other than nil to Assigned will result in True. I recommend never testing a local variable's content on any platform until it has had a value assigned in your code.
Here's an example of how to make it work. (I've also removed the unnecessary assignment to Result in the exception block.)
function TExampleDAO.Salve(const Example: TExample): Boolean;
var
dbxTransaction: TDBXTransaction;
begin
dbxTransaction := nil; // Initialize the transaction variable here
if Assigned(Example) then // prevents invalid object, like ExampleDAO.Save(nil);
begin
try
if (_connection.TransactionsSupported) AND
((not _connection.InTransaction) OR (_connection.MultipleTransactionsSupported)) then
begin
dbxTransaction := _connection.BeginTransaction(TDBXIsolations.ReadCommitted);
end;
try
// example
_sqlQuery.Close;
_sqlQuery.SQL.Clear;
_sqlQuery.SQL.Add('INSERT INTO example(a, b) '
+ 'VALUES(:a, :b)');
_sqlQuery.ParamByName('a').AsAnsiString := Example.A;
_sqlQuery.ParamByName('b').AsDateTime := Example.B;
_sqlQuery.ExecSQL(False);
// example info
_sqlQuery.Close;
_sqlQuery.SQL.Clear;
_sqlQuery.SQL.Add('INSERT INTO example_info(c, d) '
+ 'VALUES(:c, :d)');
_sqlQuery.ParamByName('c').AsInteger := Example.Info.C;
_sqlQuery.ParamByName('d').AsFloat := Example.Info.D;
_sqlQuery.ExecSQL(False);
if Assigned(dbxTransaction) then
_connection.CommitFreeAndNil(dbxTransaction);
Result := True;
except
on Exc:Exception do
begin
if Assigned(dbxTransaction) then
_connection.RollBackFreeAndNil(dbxTransaction);
raise Exc;
end;
end;
finally
if Assigned(dbxTransaction) then
FreeAndNil(dbxTransaction);
end;
end
else
begin
Result := False;
end;
end;
As was noted by #SirRufo in the comments to your question, failing to pass Example as a parameter should probably raise an exception as well, which would mean that it could become a procedure instead of a function and Result would no longer apply at all.

What does "Invalid address specified to RtlFreeHeap( 06450000, 08387460 )" mean?

Sometimes I experience random crashes in my Delphi program. My program halts, and the Debugger outputs:
Invalid address specified to RtlFreeHeap( 06450000, 08387460 )
What does that mean? And what can possibly cause it?
This is where the CPU Inspector stopped:
77BA0845 C6052582BD7700 mov byte ptr [$77bd8225],$00
Please note that they are very random (for me). Sometimes they don't appear at all.
I am using the Skype4COM.dll from Skype - there's no source though.
In case you need it, here is the code. I have commented most of the calls to Synchronize, so you know what they do.
////////////////////////////////////////////////////////////////////////////////
/// Execute
////////////////////////////////////////////////////////////////////////////////
procedure TContactDeletor.Execute;
Var
I : Integer;
UserObj : PUser;
User : IUser;
PauseEvent : TEvent;
begin
inherited;
FreeOnTerminate := True;
if Terminated then
Exit;
CoInitialize(Nil);
// The F-Flags are to make sure TSkype events do not fire (from my Main Thread)
FAllowUI := False;
FUserIsBeingDeleted := False;
FUseGroupUsersEvent := False;
FUseRenameEvent := False;
SkypeThr := TSkype.Create(Nil);
SkypeThr.Attach(10,False);
SkypeThr.Cache := False;
MyList := TStringList.Create;
PauseEvent := TEvent.Create(True);
try
// This fills my Stringlist
Synchronize(GrabList);
if Terminated then Exit;
iMax := MyList.Count;
// This sets the Max of my Progressbar
Synchronize(SetMax);
Try
for I := 0 to MyList.Count - 1 do
begin
{while SkypeThr.AttachmentStatus <> apiAttachSuccess do
begin
SkypeThr.Attach(10,False);
Synchronize(Procedure Begin Log('Skype Unavailable - Trying to reconnect ...'); End);
PauseEvent.WaitFor(5000);
end; }
CurUser := '';
User := SkypeThr.User[MyList[I]];
CurUser := MyList[I];
Try
User.IsAuthorized := False;
User.BuddyStatus := budDeletedFriend;
Except on E:Exception do
begin
ExErr := E.Message;
ExLog := 'Error while deleting contacts: ';
ExMsg := 'An Error has occured while deleting contacts: ';
Synchronize(
Procedure
Begin
Log(ExLog+ExErr+sLineBreak+' - Last logged Handle: '+CurUser);
End
);
end;
end;
iProgress := I+1;
// This updates my log and my progressbar.
Synchronize(UpdatePG);
PauseEvent.WaitFor(100);
if (I mod 200 = 0) and (I > 0) then
begin
// Calls to Synchronize updates my log
Synchronize(SyncPauseBegin);
PauseEvent.WaitFor(3000);
Synchronize(SyncPauseEnd);
end;
end;
// Except
Except on E:Exception do
begin
ExErr := E.Message;
ExLog := 'Error while deleting contacts: ';
ExMsg := 'An Error has occured while deleting contacts: ';
Synchronize(
Procedure
Begin
Log(ExMsg+ExErr+sLineBreak+' - Last logged Handle: '+CurUser);
ErrMsg(ExMsg+ExErr+sLineBreak+sLineBreak+' - Last logged Handle: '+CurUser);
End
);
Exit;
end;
end;
// This synchronizes my visual list.
Synchronize(SyncList);
finally
FUserIsBeingDeleted := False;
FUseGroupUsersEvent := True;
FUseRenameEvent := True;
FAllowUI := True;
Synchronize(
Procedure
Begin
frmMain.UpdateStatusBar;
PleaseWait(False);
ToggleUI(True);
end);
PauseEvent.Free;
SkypeThr.Free;
MyList.Free;
CoUninitialize;
end;
end;
Najem was correct, it is because your heap is corrupted. To debug it easier, you should enable PageHeap, also, use the debug CRT (or debug delphi runtime) as much as possiable until you find out what's corrupting your memory.
A lot of the time, the corruption may only spill over a few bytes. Then your application can run fine for a very long time, so you will not notice anything wrong until much later, if at all.
Try to exit your application cleanly when your looking for memory corruption bugs, dont just stop the debugger, when your process is exiting, it should "touch" most of the memory it allocated earlier and it will give you a chance to detect the failure.

Delphi - Indy (IDHTTP) Keep Session

Ok, I have Idhttp created dynamically like the following
procedure TForm1.Button1Click(Sender: TObject);
Var
Resp : String;
begin
Resp := webSession('https://www.website.com'); // HTTPS site requires session to keep alive
if Length(Resp)>0 then
MessageDlg('Got the body ok',mtInformation,[mbOk],0);
end;
function TForm1.webSession(sURL : ansistring) : ansistring;
var
SStream : Tstringstream;
HTTPCon : TIdHTTP;
AntiFreeze : TIdAntiFreeze;
CompressorZLib: TIdCompressorZLib;
ConnectionIntercept: TIdConnectionIntercept;
SSLIOHandlerSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
CookieManager: TIdCookieManager;
begin
CompressorZLib := TIdCompressorZLib.Create;
ConnectionIntercept :=TIdConnectionIntercept.Create;
SSLIOHandlerSocketOpenSSL := TIdSSLIOHandlerSocketOpenSSL.Create;
Result := '';
if Length(SettingsForm.edtProxyServer.text) >= 7 then // 0.0.0.0
Try
SStream := NIL;
AntiFreeze := NIL;
HTTPCon := NIL;
Try
SStream := tstringstream.Create('');
{ Create & Set IdHTTP properties }
HTTPCon := TIdHTTP.create;
HTTPCon.AllowCookies:=true;
HTTPCon.CookieManager :=CookieManager;
HTTPCon.Compressor := CompressorZLib;
HTTPCon.Intercept := ConnectionIntercept;
HTTPCon.IOHandler := SSLIOHandlerSocketOpenSSL;
HTTPCon.HandleRedirects := true;
{ Check Proxy }
if checkproxy('http://www.google.com') then
Begin
HTTPCon.ProxyParams.ProxyServer := SettingsForm.edtProxyServer.text;
HTTPCon.ProxyParams.ProxyPort := StrToInt(SettingsForm.edtProxyPort.Text);
HTTPCon.ProxyParams.BasicAuthentication := True;
HTTPCon.ProxyParams.ProxyUsername := SettingsForm.edtProxyServer.Text;
HTTPCon.ProxyParams.ProxyPassword := SettingsForm.edtProxyUserName.Text;
End;
{ Create another AntiFreeze - only 1/app }
AntiFreeze := TIdAntiFreeze.Create(nil);
AntiFreeze.Active := true;
HTTPCon.Get(sURL,SStream);
Result := UTF8ToWideString(SStream.DataString);
Finally
If Assigned(HTTPCon) then FreeAndNil(HTTPCon);
If Assigned(AntiFreeze) then FreeAndNil(AntiFreeze);
If Assigned(SStream) then FreeAndNil(SStream);
If Assigned(CookieManager) then FreeAndNil (CookieManager );
If Assigned(CompressorZLib) then FreeAndNil (CompressorZLib );
If Assigned(ConnectionIntercept) then FreeAndNil (ConnectionIntercept );
If Assigned(SSLIOHandlerSocketOpenSSL) then FreeAndNil (SSLIOHandlerSocketOpenSSL);
End;
Except
{ Handle exceptions }
On E:Exception do
MessageDlg('Exception: '+E.Message,mtError, [mbOK], 0);
End;
end;
function TForm1.checkproxy(sURL : ansistring) : boolean;
var
HTTPCon : TIdHTTP;
AntiFreeze : TIdAntiFreeze;
begin
Result := False;
Try
{ Inti vars }
AntiFreeze := NIL;
HTTPCon := NIL;
Try
{ AntiFreeze }
AntiFreeze := TIdAntiFreeze.Create(NIL);
AntiFreeze.Active := true;
{ Create & Set IdHTTP properties }
HTTPCon := TIdHTTP.Create(NIL);
HTTPCon.ProxyParams.ProxyServer := SettingsForm.edtProxyServer.text;
HTTPCon.ProxyParams.ProxyPort := StrToInt(SettingsForm.edtProxyPort.Text);
HTTPCon.ProxyParams.BasicAuthentication := True;
HTTPCon.ProxyParams.ProxyUsername := SettingsForm.edtProxyServer.Text;
HTTPCon.ProxyParams.ProxyPassword := SettingsForm.edtProxyUserName.Text;
HTTPCon.HandleRedirects := true;
HTTPCon.ConnectTimeout := 1000;
HTTPCon.Request.Connection := 'close';
HTTPCon.Head(sURL);
Finally
{ Cleanup }
if Assigned(HTTPCon) then
Begin
{ Return Success/Failure }
Result := HTTPCon.ResponseCode = 200;
If HTTPCon.Connected then HTTPCon.Disconnect;
FreeAndNil(HTTPCon);
End;
if Assigned(AntiFreeze) then FreeAndNil(AntiFreeze);
End;
Except
On E:EIdException do ;
{ Handle exceptions }
On E:Exception do
MessageDlg('Exception: '+E.Message,mtError, [mbOK], 0);
End;
end;
I've got a website that requires me to keep a session alive. How would I do this? With similar code to above.
If I create a visual component for everything, and use it everything is great, but when I dynamically create the component (which I REALLY want to leave it this way) it fails to keep the session alive.
Any help is appreciated.
I don't see where you instantiate CookieManager, but that's where you should keep track of the session. The server will send some cookie that represents the current session, and all further requests that you send to the server should include that cookie so the server knows which session to use.
You'll have to either keep the cookie-manager object around for the duration of the session, or you'll have to save its data somewhere else and then re-load it each time you create a new cookie-manager object. I'd prefer the former. In fact, you might consider keeping the entire HTTP object around.
As you mentioned in your comments, you are creating CookieManager in OnCreate event-handler, so that when TForm1.webSession is called, CookieManager is available, but in the finally block of TForm1.webSession you are freeing CookieManager, so once you leave TForm1.webSession method, CookieManager is out of memory. So, next time TForm1.webSession is called, CookieManager is Nil, and no cookie is saved for you.
There are two other notes that are not related to your question, but are related to your source code:
1- Your method is returning AnsiString, but you are using Utf8ToWideString for assigning value to Result variable. Utf8ToWideString returns WideString, so compiler has to convert WideString to AnsiString, and not only this reduces the performance, but also it loses the unicode characters in the returning string. You should change your method signature to return either String (D2009 & D2010) or WideString (Older versions of Delphi).
2- You don't need to check if SStream, AntiFreeze, or HTTPCon are assigned in the finally block. You can simply call the Free method, or use FreeAndNil procedure.
Regards
As Rob said your TIdCookieManager is key for maintaining a Cookie based session. The TIdCookieManager could be created in a datamodule's create event or the mainforms OnCreate() event and then set every time you create a IdHTTP component.

Resources