I am trying to create a simple object to handle all my database related functions. I have a functions to return a dataset or to execute a command. Now when i call this from my program I am able to fetch records using Execute_Dataset and it works fine but when i do an changes and execute a command by calling Execute_Command i get an error "database is locked" when the commit transaction is called. I have tried everything that i could be it still happens. Can someone put some light into what i am doing wrong and how i can prevent this from happening.
function TConnectionManager.Execute_Dataset(const ASql: string; const AParams:
array of variant; out VDataset: TDataset; const ATrn_Name: string): Boolean;
var
lTrn: TFDTransaction;
lQry: TFDQuery;
begin
Result := True;
lTrn:= TFDTransaction.Create (Self);
try
lTrn.Connection := FConnection;
lTrn.StartTransaction;
lQry := TFDQuery.Create (Self);
lQry.Connection := FConnection;
lQry.Transaction := lTrn;
try
if Length (AParams) > 0
then lQry.Open (ASql, AParams)
else lQry.Open (ASql);
VDataset := lQry;
Result := True;
{ Commit transaction if started within the procedure }
lTrn.Commit;
except
on e:Exception
do begin
{ Rollback transaction if started within the procedure }
lTrn.Rollback;
lQry.DisposeOf;
//log
raise;
end;
end;
finally
lTrn.DisposeOf;
end;
end;
procedure TConnectionManager.Execute_Command(const ASql: string; const AParams:
array of variant; const ATrn_Name: string);
var
lTrn: TFDTransaction;
lQry: TFDQuery;
begin
lTrn:= TFDTransaction.Create (Self);
try
lTrn.Connection := FConnection;
lTrn.StartTransaction;
lQry := TFDQuery.Create (Self);
lQry.Connection := FConnection;
lQry.Transaction := lTrn;
try
{ Execute command }
if Length (AParams) > 0
then lQry.ExecSQL (ASql, AParams)
else lQry.ExecSQL (ASql);
{ Commit transaction if started within the procedure }
lTrn.Commit;
except
on e:Exception
do begin
{ Rollback transaction if started within the procedure }
lTrn.Rollback;
//log
raise;
end;
end;
finally
lQry.DisposeOf;
lTrn.DisposeOf;
end;
end;
Thanks
Try setting the Connection's properties SharedCache to 'False' and LockingMode to 'Normal'.
The default value for the connection's locking mode is 'exclusive' which can cause this problem. You can do this by right clicking on your Connection-Component (on the form) and choosing ConnectionEditor (I'm not quite sure, if that's the right English word for it, but it should be called something like that) and then setting these values.
Alternatively you can set these properties in sourcecode:
connection.Params.Add('SharedCache=False');
connection.Params.Add('LockingMode=Normal');
I'm not sure that this is the best way to solve this problem. There might be a better solution to this.
Because other connection exist. Check connection component in datamodule
MyFDConnection.Connected:=False;
Sharedcache = false is indeed the best way to solve this problem. The components already support designtime connections.
Related
The code below works fine if executed as a single command. I use it to download PDFs that are typically a few megabytes in size.
However, when I execute it multiple times in a loop, all the downloaded files are exactly the same size (truncated # ~50KB). Is there an issue with my code or is this the server not being able to deliver as expected?
type
TKeyValuePair = record
Key: String;
Value: String;
end;
TKeyValueSet = Array of TKeyValuePair;
// ...
function TDM.MultipartPost(const URL, LocalFile: String; const MultipartData: TKeyValueSet): Boolean;
var
i: Integer;
httpclient: THTTPClient;
formdata: TMultipartFormData;
fstream: TFileStream;
begin
httpclient := THTTPClient.Create;
formdata := TMultipartFormData.Create();
fstream := nil;
try
fstream := TFileStream.Create(LocalFile, fmCreate);
except
// removed
end;
try
for i := Low(MultipartData) to High(MultipartData) do
formdata.AddField(MultipartData[i].Key, MultipartData[i].Value);
try
httpclient.Post(url, formdata, fstream);
except
// removed
end;
finally
FlushFileBuffers(fstream.Handle);
fstream.Free;
formdata.Free;
httpclient.Free;
//
Result := FileExists(LocalFile) and (GetFileSize(LocalFile) > 0);
end;
end;
Mea culpa - my apologies to all that read/replied to my post. I just built a minimal, but complete application to demonstrate the issue and, voila, it worked just fine.
1 hour or so of not seeing the forest for all the trees later:
I accidentally used an incorrect URL to post to :(
what is the best method to do this: i have a txt file filled with web addresses, i have to check all of them using idHTTP component,only a simple check from a web server, downloading the html and finding a match, i want it to to be fast, there is different types of threads and i am not sure what is the best to use, a TParallel for or Task threads or regular threads?
i tried before TParallel for and i got stuck at AV, also i've tried Task threads but its not fast, the http request becomes slower by time, i tried also the regular threads and i didnt know how to use it because its complicated to use.
note: Please do NOT downvote i just need advice from the experts. Thank you
First advice: do not use Indy. Use THTTPClient (unit System.Net.HttpClient) -- native for Delphi XE?+
I am still using old TThreads. I could make suggestion only with TThread.
Workflow:
Main thread -- reading your TXT file line by line.
After line was readed, you create NEW thread, which are downloading information from WWW.
Sample of application:
unit ufmMain;
interface
uses
Winapi.Windows, Winapi.Messages,
System.SysUtils, System.Variants,
{ TThread }
System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TLoad = class(TThread)
protected
FURL,
FOutputFileName: String;
procedure Execute; override;
public
constructor Create(const AURL, AOutputFileName: String); overload;
end;
HTTP = class
public
class procedure Get(const AURL: String; out AOutputStream: TMemoryStream);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
{ THTTPClient }
System.Net.HttpClient;
procedure TForm1.Button1Click(Sender: TObject);
var
LLoad: TLoad;
LFile: TextFile;
LCycle: Integer;
LUrl: String;
begin
LCycle := 0;
AssignFile(LFile, 'urls.txt');
try
Reset(LFile);
while not Eof(LFile) do
begin
{ Using for generate file name. All file names must be unique }
Inc(LCycle);
{ Read next URL }
ReadLn(LFile, LUrl);
{ Create new thread }
LLoad := TLoad.Create(LUrl, 'Output file No ' + LCycle.ToString + '.htm');
LLoad.FreeOnTerminate := True;
LLoad.Start;
end;
finally
CloseFile(LFile);
end;
end;
{ TLoad }
constructor TLoad.Create(const AURL, AOutputFileName: String);
begin
inherited Create(True);
FURL := AURL;
FOutputFileName := AOutputFileName;
end;
procedure TLoad.Execute;
var
LResponse: TMemoryStream;
begin
inherited;
LResponse := TStringStream.Create;
try
HTTP.Get(FURL, LResponse);
{ Save result to file }
LResponse.SaveToFile(GetCurrentDir + PathDelim + FOutputFileName);
finally
LResponse.Free;
end;
end;
{ HTTP }
class procedure HTTP.Get(const AURL: String; out AOutputStream: TMemoryStream);
var
LStream: TStream;
LHTTPClient: THTTPClient;
begin
LHTTPClient := THTTPClient.Create;
try
LStream := LHTTPClient.Get(AURL).ContentStream;
AOutputStream.CopyFrom(LStream, LStream.Size);
finally
LHTTPClient.Free;
end;
end;
end.
Why I against Indy:
1) THTTPClient do not required additional DLL for works with SSL protocol
2) THTTPClient is modern from Delphi XE8
3) My subjective opinion: THTTPClient works much more smoothly (with less issues) then Indy library. I used Indy for last 10 years, but now all my supported project moved to THTTPClient.
You can use TTask and Indy (TIdHTTP). Example:
function GetUrl(const aUrl: string): ITask;
begin
Result := TTask.Run(
procedure
var
FOutput: string;
FHTTP: TIdHTTP;
begin
FHTTP:=TIdHTTP.Create(nil);
try
try
FOutput:=FHTTP.Get(aUrl);
except
// handle errors
end;
finally
FHTTP.Free;
end;
TThread.Synchronize(nil,
procedure
begin
ProcessOutput(FOutput); // send your output/result to main thread
end);
end );
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
list: TStringList;
begin
list:=TStringList.Create;
try
list.LoadFromFile('yourfile.txt');
// get all your urls
// you should control how many threads run at the same time
for i := 0 to list.Count-1 do
GetUrl(list[i]);
finally
list.Free;
end;
end;
I'm trying to implement asynchronous WMI queries in my Inno Setup project. But I'm struggling with the event definitions. I'm getting a Type mismatcherror on the line
objSink.OnCompleted := #WMI_OnCompleted;
I am assuming that my event definition is wrong. How can I find the right object types for the event?
procedure QueryWMIAsync(Qry: string; var objSink: Variant);
var
WbemLocator, WbemServices, WbemObjects: Variant;
begin
log('WMI AsyncQuery: '+Qry);
try
WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
objSink.OnCompleted := #WMI_OnCompleted; //<----- Error: Type mismatch
objSink.OnObjectReady := #WMI_OnObjectReady;
WbemServices := WbemLocator.ConnectServer('localhost', 'root\CIMV2');
WbemServices.ExecQueryAsync(objSink, Qry);
except
MsgBox('ERROR on WMI Query <'+Qry+'>: '+GetExceptionMessage,mbError,MB_OK);
end;
end;
procedure WMI_OnCompleted(hResult: HRESULT; error: Variant; asyncContext: Variant);
begin
end;
According to the Inno Setup Newsgroup this actually seems to be impossible. At least with my approach:
http://news.jrsoftware.org/read/article.php?id=30095&group=jrsoftware.innosetup.code#30095
I'm using the excellent Inno Setup installer and I notice that some Applications (often from Microsoft) get installed with their launch icon already highly visible ('pinned?') in the start menu (in Windows 7). Am I totally reliant on the most-recently-used algorithm for my icon to be 'large' in the start menu, or is there a way of promoting my application from the installer please?
It is possible to pin programs, but not officially. Based on a code posted in this thread (which uses the same way as described in the article linked by #Mark Redman) I wrote the following:
[Code]
#ifdef UNICODE
#define AW "W"
#else
#define AW "A"
#endif
const
// these constants are not defined in Windows
SHELL32_STRING_ID_PIN_TO_TASKBAR = 5386;
SHELL32_STRING_ID_PIN_TO_STARTMENU = 5381;
SHELL32_STRING_ID_UNPIN_FROM_TASKBAR = 5387;
SHELL32_STRING_ID_UNPIN_FROM_STARTMENU = 5382;
type
HINSTANCE = THandle;
HMODULE = HINSTANCE;
TPinDest = (
pdTaskbar,
pdStartMenu
);
function LoadLibrary(lpFileName: string): HMODULE;
external 'LoadLibrary{#AW}#kernel32.dll stdcall';
function FreeLibrary(hModule: HMODULE): BOOL;
external 'FreeLibrary#kernel32.dll stdcall';
function LoadString(hInstance: HINSTANCE; uID: UINT;
lpBuffer: string; nBufferMax: Integer): Integer;
external 'LoadString{#AW}#user32.dll stdcall';
function TryGetVerbName(ID: UINT; out VerbName: string): Boolean;
var
Buffer: string;
BufLen: Integer;
Handle: HMODULE;
begin
Result := False;
Handle := LoadLibrary(ExpandConstant('{sys}\Shell32.dll'));
if Handle <> 0 then
try
SetLength(Buffer, 255);
BufLen := LoadString(Handle, ID, Buffer, Length(Buffer));
if BufLen <> 0 then
begin
Result := True;
VerbName := Copy(Buffer, 1, BufLen);
end;
finally
FreeLibrary(Handle);
end;
end;
function ExecVerb(const FileName, VerbName: string): Boolean;
var
I: Integer;
Shell: Variant;
Folder: Variant;
FolderItem: Variant;
begin
Result := False;
Shell := CreateOleObject('Shell.Application');
Folder := Shell.NameSpace(ExtractFilePath(FileName));
FolderItem := Folder.ParseName(ExtractFileName(FileName));
for I := 1 to FolderItem.Verbs.Count do
begin
if FolderItem.Verbs.Item(I).Name = VerbName then
begin
FolderItem.Verbs.Item(I).DoIt;
Result := True;
Exit;
end;
end;
end;
function PinAppTo(const FileName: string; PinDest: TPinDest): Boolean;
var
ResStrID: UINT;
VerbName: string;
begin
case PinDest of
pdTaskbar: ResStrID := SHELL32_STRING_ID_PIN_TO_TASKBAR;
pdStartMenu: ResStrID := SHELL32_STRING_ID_PIN_TO_STARTMENU;
end;
Result := TryGetVerbName(ResStrID, VerbName) and ExecVerb(FileName, VerbName);
end;
function UnpinAppFrom(const FileName: string; PinDest: TPinDest): Boolean;
var
ResStrID: UINT;
VerbName: string;
begin
case PinDest of
pdTaskbar: ResStrID := SHELL32_STRING_ID_UNPIN_FROM_TASKBAR;
pdStartMenu: ResStrID := SHELL32_STRING_ID_UNPIN_FROM_STARTMENU;
end;
Result := TryGetVerbName(ResStrID, VerbName) and ExecVerb(FileName, VerbName);
end;
The above code first reads the caption of the menu item for pinning or unpinning applications from the string table of the Shell32.dll library. Then connects to the Windows Shell, and for the target app. path creates the Folder object, then obtains the FolderItem object and on this object iterates all the available verbs and checks if their name matches to the one read from the Shell32.dll library string table. If so, it invokes the verb item action by calling the DoIt method and exits the iteration.
Here is a possible usage of the above code, for pinning:
if PinAppTo(ExpandConstant('{sys}\calc.exe'), pdTaskbar) then
MsgBox('Calc has been pinned to the taskbar.', mbInformation, MB_OK);
if PinAppTo(ExpandConstant('{sys}\calc.exe'), pdStartMenu) then
MsgBox('Calc has been pinned to the start menu.', mbInformation, MB_OK);
And for unpinning:
if UnpinAppFrom(ExpandConstant('{sys}\calc.exe'), pdTaskbar) then
MsgBox('Calc is not pinned to the taskbar anymore.', mbInformation, MB_OK);
if UnpinAppFrom(ExpandConstant('{sys}\calc.exe'), pdStartMenu) then
MsgBox('Calc is not pinned to the start menu anymore.', mbInformation, MB_OK);
Please note that even though this code works on Windows 7 (and taskbar pinning also on Windows 8.1 where I've tested it), it is really hacky way, since there is no official way to programatically pin programs to taskbar, nor start menu. That's what the users should do by their own choice.
There's a reason there's no programmatic way to pin things to the taskbar/start menu. In my experience, I have seen the start menu highlight newly-created shortcuts, and that's designed to handle exactly this situation. When you see a newly-installed program show up on the start menu, it's probably because of that algorithm and not because the installer placed it there.
That said, if a new shortcut does not appear highlighted, it may be because the installer extracts a pre-existing shortcut and preserves an old timestamp on it, rather than using the API function to create a shortcut in the start menu.
Have a look at: http://blogs.technet.com/deploymentguys/archive/2009/04/08/pin-items-to-the-start-menu-or-windows-7-taskbar-via-script.aspx
I have the following situation:
function Mach3Code(Str: String): String;
var StrOut: String;
begin
StrOut := '';
try
IdTelnet1.Connect();
IdTelnet1.Write(Str);
StrOut := ''; // assign here return output;
finally
IdTelnet1.Disconnect;
end;
Result := StrOut;
end;
On the line "StrOut := '';" I need to get the text output of the server (which is a tcp server, written in vc 2008 by me as Mach3 plugin).
Normally, the client sends "COMMAND1" and the server replies with "ANSWER1#" or something like this. I need the code to wait for the answer and then return it, synchronously, so I can do something like:
StrResult := Mach3Code('G0X300Y200');
and read what the server part has sent to me.
any ideas how I can solve this problem?
TIdTelnet is an asynchronous componnt, it is not suited for what you are attempting to do. Unless you are dealing with the actual Telnet protocol, then you should use TIdTCPClient instead:
function Mach3Code(const Str: String): String;
begin
Result := '';
try
IdTCPClient1.Connect();
IdTCPClient1.WriteLn(Str);
StrOut := IdTCPClient1.ReadLn('#');
finally
IdTCPClient1.Disconnect;
end;
end;
to receive data assign an event handler of type TIdTelnetDataAvailEvent to the OnDataAvailable property of idtelnet1, i know this is not synchronous but i would re factor your code to work this way as this is how the telnet client is designed to work.
Failing that create your own TIdTCPClientCustom decendant and implement your own read thread with the relevent methods.