I'm trying to add events to a dynamically created component named webcopy from TMS Software. The code works ok for static component added to form but if I want to create a dynamic one I'm unable to execute different events.
Here is the code that works ok except the part event webcopy.OnFileDone:
public
{ Public declarations }
procedure delete_file_after_upload(Sender:TObject; idx:integer);
end;
procedure Tform2.delete_file_after_upload(Sender:TObject; idx:integer);
begin
showmessage('FILENAME"'+upload_filename+'" SUCCESSFULLY UPLOADED TO FTP');
deletefile(upload_filename);
end;
procedure upload_file_to_ftp(filename,ftp_host,ftp_port,ftp_user,ftp_password,ftp_directory:string);
var webcopy:Twebcopy;
begin
try
webcopy:=Twebcopy.Create(NIL);
Webcopy.Items.Clear;
with WebCopy.Items.Add do
begin
{upload_filename = global variable so i can delete it after succesfully uploading it to ftp}
upload_filename:=filename;
protocol := wpFtpUpload;
URL:=filename; // local file that is input
FTPHost := ftp_host;
FtpPort := strtoint(ftp_port);
FTPUserID := ftp_user;
FTPPassword := ftp_password;
TargetDir := ftp_directory; // path to use on FTP server
{after the uploading process is done I want to delete the file from pc}
webcopy.OnFileDone:= Form2.delete_file_after_upload;
end;
finally
WebCopy.Execute;
freeandnil(webcopy);
end;
end;
The handler must have appropriate signature.
The type for the event handler is defined as
TWebCopyFileDone = procedure(Sender:TObject; idx:integer) of object;
Thus, your handler procedure must be a method of some class (this is what of object means), and accept two parameters, TObject and Integer.
For example:
procedure TForm2.delete_file_after_upload(Sender:TObject; idx:integer);
begin
...
You'll also have to add declaration of the method to public section of TForm2.
Related
Is there a built-in way to get the standard extension of a given MIME type in Delphi (XE7)?
I'm looking for the easiest and most general way to implement a function that would be called like this:
fileExt := GetExtension('text/xml');
It seems Indy has a built in function for that, on TIdThreadSafeMimeTable:
Uses
IdCustomHTTPServer;
function GetMIMETypeDefaultExtension(const aMIMEType: String): String;
var
mimetable: TIdThreadSafeMimeTable;
Begin
if not(aMIMEType.Trim.IsEmpty) then
Begin
mimetable := TIdThreadSafeMimeTable.Create(true);
try
result := mimetable.GetDefaultFileExt(aMIMEType);
finally
mimetable.Free;
end
End
else
result := '';
End;
Edit: function fixed to use TIdThreadSafeMimeTable directly without custom http server.
Indy's IndyProtocols package has a TIdMimeTable class and standalone GetMIMETypeFromFile() and GetMIMEDefaultFileExt() wrapper functions in the IdGlobalProtocols unit, eg:
uses
..., IdGlobalProtocols;
function GetExtension(const AMIMEType: string);
begin
Result := GetMIMEDefaultFileExt(AMIMEType);
end
Just know that internally, GetMIMEDefaultFileExt() creates and destroys a TIdMimeTable object, and that object re-builds its list of known extensions and MIME types every time it is created. If you are going to be querying MIME extensions frequently, it would be worth creating your own TIdMimeTable object (or TIdThreadSafeMimeTable if you need to share the table across multiple threads) and reuse it each time:
uses
..., IdGlobalProtocols;
var
MimeTable: TIdMimeTable = nil;
function GetExtension(const AMIMEType: string);
begin
if MimeTable = nil then
MimeTable := TIdMimeTable.Create;
Result := MimeTable.GetDefaultFileExt(AMIMEType);
end;
initialization
finalization
MimeTable.Free;
uses
..., IdGlobalProtocols, IdCustomHTTPServer;
var
MimeTable: TIdThreadSafeMimeTable = nil;
function GetExtension(const AMIMEType: string);
begin
if MimeTable = nil then
MimeTable := TIdThreadSafeMimeTable.Create;
Result := MimeTable.GetDefaultFileExt(AMIMEType);
end;
initialization
finalization
MimeTable.Free;
HKEY_CLASSES_ROOT\MIME\Database\Content Type\text/html, value Extension.
For more current versions of Delphi, you can use the TMimeTypes class in the unit System.Net.Mime
There are two methods which you can use to seed the internal dictionary to perform the lookup. The first AddDefTypes will add the standard types, and the method AddOSTypes will add any defined by the host OS (for windows, it does a registry crawl). If you call TMimeTypes.GetDefault it will construct a TMimeTypes instance using both methods the first time it is called (singleton).
I'm porting an old application from delphi7 to delphi xe8
and from intraweb 8 to intraweb XIV
My app was subdivided in a main program and a number of child packages
and it worked perfectly with the old components.
With theese new components, I now get an exception trying to generate and return a page to the server controller, creating such a page from a child package.
If instead I generate the page from the main app, it works.
In the procedure TIWServerController.IWServerControllerBaseGetMainForm
I call a procedure of a my component (packman) that tries to obtain a main window from a child package.
this is the servercontroller function
procedure TIWServerController.IWServerControllerBaseGetMainForm(var vMainForm : TIWBaseForm);
begin
VMainForm := PackMan.MainLoginForm(webApplication);
end;
and this is the packman function:
function tPackMan.MainLoginForm (aOwner:tComponent) : tIwAppForm;
var Proc : tGetMainFormProc;
begin
#Proc := GetProcAddress (LoginPkg,'MainForm');
Result := Proc(aOwner);
end;
this is the definition of the procedural type:
tGetMainFormProc = function (aOwner:tComponent): tIwAppForm;
and this is the MainForm procedure, in the child package (packlogin).
Initially I tried to create the original form, full of components,
after that I've removed all components from original form, without success,
and finally I tried to construct an empty form, as shown in this sample:
function MainForm (aOwner:tComponent): tIWAppForm;
begin
Result := tIWAppForm.Create(aOwner);
end;
exports MainForm;
I've traced the program behaviour using several Outputdebugstring messages (here not shown) and I've come to the following conclusion:
1) the Mainform procedure, in the package, seems to return a valid tIwAppform
2) this Object is correctly returned to the IWServerControllerBaseGetMainForm procedure
and the variable VMainForm is correctly assigned.
3) if I inspect the classname property of this variable, I see it has the value "tIWAppform".
The exception seems to be generated at the procedure return.
I've interceped it in the procedure IWServerControllerBaseException
with the following code :
procedure TIWServerController.IWServerControllerBaseException(
AApplication: TIWApplication; AException: Exception;
var Handled: Boolean);
begin
Dump ('UNEXPECTED EXCEPTION ' + AException.message);
Handled := true;
end;
What am I missing ?
Any suggestion ?
Regards.
Maurizio.
Given a IScriptObj reference how does one get to a corresponding IInfo or TProgramInfo?
I have a script object that wraps a Delphi object.
In order to manage the life time of the script object the Delphi object stores a reference to the script object. The Script object is declared with a TdwsUnit component. It's pretty standard and goes something like this:
Delphi
type
TDelphiObject = class
private
FScriptObject: IScriptObj;
public
procedure DoSomething;
property ScriptObject: IScriptObj read FScriptObject write FScriptObject;
end;
Script
type
TScriptObject = class
protected
procedure DoSomething; virtual;
public
constructor Create;
end;
The instantiation of the Delphi object and setup of the Delphi/script links happens in the Delphi implementation of the script object constructor. Also pretty standard:
Delphi
// Implements TScriptObject.Create
procedure TMyForm.dwsUnitClassesTScriptObjectConstructorsCreateEval(Info: TProgramInfo; var ExtObject: TObject);
var
DelphiObject: TDelphiObject;
DelphiObjectInfo: IInfo;
begin
// Create the Delphi-side object
DelphiObject := TDelphiObject.Create;
// Get the script object "self" value
DelphiObjectInfo := Info.Vars['self'];
// Store the ScriptObject reference
DelphiObject.ScriptObject := DelphiObjectInfo.ScriptObj;
// Return the instance reference to the script
ExtObject := DelphiObject;
end;
Ideally I would have saved the IInfo reference rather that the IScriptObj since IInfo does everything I need later on, but from experience it seems the IInfo object is only valid for the duration of the method call.
Anyway, the problem occurs later on when TDelphiObject.DoSomething is called on the Delphi side.
TDelphiObject.DoSomething is meant to call the corresponding virtual method on the script object:
Delphi
procedure TDelphiObject.DoSomething;
var
Info: IInfo;
DoSomethingInfo: IInfo;
begin
// I have a IScriptObj but I need a IInfo...
Info := { what happens here? };
// Call the virtual DoSomething method
DoSomethingInfo := Info.Method['DoSomething'];
DoSomethingInfo.Call([]);
end;
I have tried a lot of different techniques to get a usable IInfo or TProgramInfo from the stored IScriptObj but every thing has failed. So what is the correct way of doing this?
The problem turned out to be that I assumed I needed an IInfo interface to encapsulate the object instance but apparently DWScript doesn't work that way. What I need is to create a temporary reference/pointer to the instance and then create an IInfo on that instead.
Here's how that is done:
procedure TDelphiObject.DoSomething;
var
ProgramExecution: TdwsProgramExecution;
ProgramInfo: TProgramInfo;
Data: TData;
DataContext: IDataContext;
Info: IInfo;
DoSomethingInfo: IInfo;
begin
(*
** Create an IInfo that lets me access the object represented by the IScriptObj pointer.
*)
// FProgramExecution is the IdwsProgramExecution reference that is returned by
// TdwsMainProgram.CreateNewExecution and BeginNewExecution. I have stored this
// elsewhere.
ProgramExecution := TdwsProgramExecution(FProgramExecution);
ProgramInfo := ProgramExecution.AcquireProgramInfo(nil);
try
// Create a temporary reference object
SetLength(Data, 1);
Data[0] := FScriptObject;
ProgramInfo.Execution.DataContext_Create(Data, 0, DataContext);
// Wrap the reference
Info := TInfoClassObj.Create(ProgramInfo, FScriptObject.ClassSym, DataContext);
// Call the virtual DoSomething method
DoSomethingInfo := Info.Method['DoSomething'];
DoSomethingInfo.Call([]);
finally
ProgramExecution.ReleaseProgramInfo(ProgramInfo);
end;
end;
What this does is enable object oriented call backs from Delphi to the script. Without this it is only possible to call global script functions from Delphi.
FWIW, the following two lines from the above:
ProgramInfo.Execution.DataContext_Create(Data, 0, DataContext);
Info := TInfoClassObj.Create(ProgramInfo, FScriptObject.ClassSym, DataContext);
can be replaced with a call to CreateInfoOnSymbol (declared in dwsInfo):
CreateInfoOnSymbol(Info, ProgramInfo, FScriptObject.ClassSym, Data, 0);
We have a service (written in C#) running to check somethings every 10 minutes and if something new happened, then send an email to someone special.
We also have other Delphi program and want to pass a parameter to the service to act on and send email immediately (I mean regardless than 10 minutes interval).
How to do that while service is running ?
note: There is no way to migrate to C# we have to do that in Delphi.
There's also a possibility to use ControlService API to send the service a user-defined control code. (The service has to be written to respond to that specific control code.)
You need to use some form of inter process communication (IPC). There are many possibilities. Most commonly used for such a scenario are named pipes and TCP/sockets.
There are some good answers here already... and here's mine:
You could use a text file or the windows registry to flag for action. This way your Delphi service can react upon start-up should the trigger have occured while your service was not running. Any information/parameters you wish to convey can be included in the registry-key value or as file data.
Win Registry Method:
If you use a registry-key make sure that both apps can read and write to the same key.
In your Delphi Service implement the RegNotifyChangeKeyValue WinAPI which will notify when the key is added/altered. Here's an idea how you can implement the listner in Delphi: Monitoring Registry Changes
File Method:
To be notified about file changes you do not need to poll for changes. Below is code for a solution based on the FindFirstChangeNotification WinAPI. Your Delphi Service can implement the TFileWatch class. You will also need a unit with the class TDirectoryWatch class by Angus Johnson.
unit FileWatch;
interface
uses Classes,
SysUtils,
DirWatch; //by Angus Johnson: http://www.angusj.com/delphi/dirwatch.html
type TFileNotifyEventType = (feCreated, feModified, feDeleted);
TFileNotifyEvent = procedure(Sender: TObject; FileEventType : TFileNotifyEventType) of object;
TFileWatch = class(TComponent)
private
FDirWatch : TDirectoryWatch;
FFileToWatch : string;
FFileAge : integer; //if -1 then file does not exist
FFileExists : boolean;
procedure OnFolderChangeEvent(Sender: TObject);
protected
public
OnFileNotifyEvent : TFileNotifyEvent;
property Filename : string read FFileToWatch;
constructor Create(aOwner: TComponent; FileToWatch : string);
destructor Destroy();
end;
implementation
{ TFileWatch }
constructor TFileWatch.Create(aOwner: TComponent; FileToWatch: string);
begin
inherited Create(aOwner);
FDirWatch := TDirectoryWatch.Create(Self);
FDirWatch.Directory := ExtractFilePath(FileToWatch);
FDirWatch.OnChange := OnFolderChangeEvent;
FDirWatch.NotifyFilters := [nfFilename, nfLastWrite];
FDirWatch.Active := true;
FFileToWatch := FileToWatch;
FFileAge := FileAge(FFileToWatch);
FFileExists := FFileAge > -1;
end;
destructor TFileWatch.Destroy;
begin
FDirWatch.Free;
inherited Destroy;
end;
procedure TFileWatch.OnFolderChangeEvent(Sender: TObject);
var MyFileAge : integer;
MyFileExists : boolean;
FileEventType : TFileNotifyEventType;
begin
//Check to see if the event has been fired by our file in question
MyFileAge := FileAge(FFileToWatch);
if MyFileAge = FFileAge then
exit; //Nothing has happened, exit.
//Figure out if the file has been created, modified or deleted
MyFileExists := MyFileAge > -1;
if MyFileExists and not FFileExists then
FileEventType := feCreated
else if not MyFileExists and FFileExists then
FileEventType := feDeleted
else
FileEventType := feModified;
FFileAge := MyFileAge;
FFileExists := MyFileExists;
if Assigned(OnFileNotifyEvent) then
OnFileNotifyEvent(Self, FileEventType);
end;
end.
I often communicate via a database. I'd store a certain value with process X, and process Y reads it.
The nice thing about that design is that the two applications don't need to know eachother. They can easily run on different machines, and you can have multiple readers and writers, so you can easily scale things up. You also get encryption and compressed connections for free if you need it, and all sorts of complicated multi user stuff is taken care of.
I would suggest adding a WCF Service to (hosted by) your Windows service exposing the required function.
I use following procedure to encode stream.
procedure SaveEncodedStream(Strm:TStream; LicFileName:String);
var
C:TCodec;
CL:TCryptographicLibrary;
Sg:TSignatory;
KFS,DFS:TFileStream;
Dir:String;
begin
CL:=TCryptographicLibrary.Create(nil);
C:=TCodec.Create(nil);
SG:=TSignatory.Create(nil);
Dir := ExtractFilePath(ParamStr(0));
KFS:=TFileStream.Create(Dir+PublicKeyFile,fmOpenRead);
DFS:=TFileStream.Create(LicFileName,fmCreate);
try
C.CryptoLibrary:=CL;
C.BlockCipherId := 'native.RSA';
C.ChainModeId := 'native.CBC';
C.AsymetricKeySizeInBits := 1024;
SG.Codec:=C;
SG.LoadKeysFromStream(KFS,[partPublic]);
C.EncryptStream(Strm,DFS);
finally
CL.Free;
C.Free;
SG.Free;
KFS.Free;
DFS.Free;
end;
end;
And receive "Wrong Mode" error on
C.EncryptStream(Strm,DFS); call
Stepping into the code I discovered that it even does not try to load keys as Codec is not initialized. When I place componets on the form - everything works. But I do not need Form or DataModule.
Have not found solution to get rid of DataModule. It looks like components need one to properly initialize themselves. So as workaround I have created global DataModule with all components configured in design mode. I use that module in SaveEncodedStream like that:
uses
... EncryptDataModule;
...
var
BeenHere:Boolean = false;
...
procedure SaveEncodedStream(Strm:TStream; LicFileName:String);
var
KFS,DFS:TFileStream;
Dir:String;
begin
Dir := ExtractFilePath(ParamStr(0));
KFS:=TFileStream.Create(Dir+PublicKeyFile,fmOpenRead);
DFS:=TFileStream.Create(LicFileName,fmCreate);
try
DataModule.SG.LoadKeysFromStream(KFS,[partPublic]);
if BeenHere then DataModule.C.Reset;
DataModule.C.EncryptStream(Strm,DFS);
BeenHere:=true;
finally
KFS.Free;
DFS.Free;
end;
end;