I created a program to get a file from FTP servers every 5 seconds.
(I'm using Delphi 7)
To do this I did an IdFTP array.
Everything looks like OK, but when the file doesn't exist, the application crashes.
Message: Project FTPGETFIle.exe raised exception class EldProtocolReplyError with message 'File not found'
Creating array from INI file:
IFTP[i] := TIdFTP.Create(nil);
IFTP[i].Host := IniFile.hostn[i];
IFTP[i].Username := IniFile.usern;
IFTP[i].Password := IniFile.password;
IFTP[i].Port := IniFile.FTPPort;
IFTP[i].OnConnected := FTPConnect;
IFTP[i].OnDisconnected := FTPDisconnect;
IFTP[i].OnStatus := FTPStatus;
IFTP[i].Passive := True;
Get file timer:
procedure TfrmMain.Timer1Timer(Sender: TObject);
var
i : Integer;
begin
for i := 1 to IniFile.nftp do
begin
if pingIP(IniFile.hostn[i]) then
begin
if IFTP[i].Connected then
begin
writelog ('Get file '+IniFile.FTPFile[i]+' and save to '+IniFile.OutputF[i]);
try
IFTP[i].Get (IniFile.FTPFile[i],IniFile.OutputF[i],true, false);
except
on E:EIdFileNotFound do
writelog(E.Message);
on E:EIdProtocolReplyError do
writelog(E.Message);
on E:Exception do
writelog(e.Message);
end;
end;
end
else
writelog(IniFile.hostn[i]+' is not recheable!');
end;
end;
Can someone help me to treat this "file not found"?
Related
How to load a report FastReports totally in runtime?
I would like to load and run my reports all at runtime. I designed the reports in the FastReports editor, saved the project file and now I need to load them at runtime.
Everything will be created at runtime.
frxReport
frxDBDataset
frxPDFExport
I set up the coding, however there is an error in PrepareReport, because FastReports looks for the frxDBDataSet1 linked in the report and cannot find it.
I'm not sure how to do this step.
My method looks like this:
procedure TServerReports.Catalogo;
var
LReport : TfrxReport;
LPDF : TfrxPDFExport;
LDataSet : TfrxDBDataset;
LFileName : string;
begin
try
LReport := TfrxReport.Create(nil);
LDataSet := TfrxDBDataset.Create(nil);
LDataSet.DataSet := Query;
LPDF := TfrxPDFExport.Create(nil);
LReport.DataSets.Add(LDataSet);
LReport.LoadFromFile(Format('%s\%s', [TConfig.DirFastReports, 'Catalogo_02.fr3']));
LReport.DataSet := LDataSet;
LFileName := Format('%s\Catalogo%s.pdf', [TConfig.DirSaveReports, FormatDateTime('DDMMYYYhhmmss', Now)]);
LReport.FileName := LFileName;
LReport.PrepareReport(); //Error because frxDBDataSet1
LReport.ShowProgress := False;
LReport.PrintOptions.ShowDialog := False;
LPDF.ShowProgress := False;
LPDF.ShowDialog := False;
LPDF.FileName := LFileName;
LReport.Export(LPDF);
except on E:Exception do
begin
raise Exception.Create(E.Message);
end;
end;
end;
I receive this error:
When a file is double-clicked, I want it to open in the running instance of my Firemonkey app. For the moment, I am just trying to get the code working in Win32 but ultimately I want similar behavior in OSX.
I have the following code in my .dpr. I found the part relating to the mutex on https://forums.embarcadero.com/message.jspa?messageID=873440 and it works fine in suppressing the opening of a second instance.
var
OneInstanceMutex: THandle = 0;
MessageManager: TMessageManager;
Message: TMessage;
function InstanceAlreadyExists(const MutexName: string): Boolean;
begin
Result := False;
// .. This mutex will be freed when the application closes!
OneInstanceMutex := CreateMutex (nil, FALSE, PChar(MutexName) );
if OneInstanceMutex <> 0 then
begin
if GetLastError() = ERROR_ALREADY_EXISTS then
begin
// Found another instance
Result := True;
end;
end
else
begin
if GetLastError() = ERROR_ACCESS_DENIED then
begin
// Found another instance
Result := True;
end;
end;
end;
begin
if InstanceAlreadyExists('MyApp.exe') then
begin
MessageManager := TMessageManager.DefaultManager;
Message := TMessage<UnicodeString>.Create(ParamStr(1));
MessageManager.SendMessage(nil, Message, True);
Exit;
end;
Application.Initialize;
In the main form, in the FormCreate event, I have
procedure TMyMainForm.FormCreate(Sender: TObject);
var
SubscriptionId: Integer;
MessageManager: TMessageManager;
begin
....
MessageManager := TMessageManager.DefaultManager;
SubscriptionId := MessageManager.SubscribeToMessage(TMessage<UnicodeString>,
procedure(const Sender: TObject; const M: TMessage)
begin
ShowMessage((M as TMessage<UnicodeString>).Value);
end);
// I'm expecting the above to show the filename to be opened
// but no message appears
....
end;
With one instance already running, when I double-clicking on a file, I'm expecting the line
ShowMessage((M as TMessage<UnicodeString>).Value);
to display the filename to be opened but no message appears.
BTW, I have correctly associated the file extension with my app so that the .dpr is receiving ParamStr(1). It's just that the broadcasting of this string to the already running instance isn't working.
I tried this code to save some fields and an image.
I use MySQL and zzeos for connectinf to the database.
How to fix this code ?
procedure Tfbiodata.btnSaveClick(Sender: TObject);
var
gambar : TMemoryStream;
begin
if (edtnis.Text='') or (edtname.Text='') or (cmbjk.Text='') or (edtempat.Text='') or (edtgl.Text='') or (cmbtingkatan.Text='') then
begin
ShowMessage('Maaf !!! Data Anda Belum Lengkap ....');
exit;
end;
begin
zbiodata2.Open;
zbiodata2.Append;
zbiodata2.FieldByName('NIS').AsString := edtnis.Text;
zbiodata2.FieldByName('Nama_siswa').AsString := edtname.Text;
zbiodata2.FieldByName('Jenis_kelamin').AsString := cmbjk.Text;
zbiodata2.FieldByName('Tempat_lahir').AsString := edtempat.Text;
zbiodata2.FieldByName('Tanggal_lahir').AsString := edtgl.Text;
zbiodata2.FieldByName('Tingkatan').AsString := cmbtingkatan.Text;
zbiodata2.FieldByName('Hasil_indentifkasi').AsString := lblhasil.Caption;
zbiodata2.FieldByName('Metode_pembeaaran').AsString := memo1.Text;
try
convertobmp(openpicture.FileName);
gambar := TMemorystream.Create;
image1.Picture.Graphic.SaveToStream(gambar);
zbiodata2.SQL.Text := 'insert into biodata (gambar) values (:p0)';
zbiodata2.Params[0].LoadFromStream(gambar,ftBlob);
zbiodata2.Post;
zbiodata2.ExecSQL;
except
on E:Exception do
ShowMessage('sorry this a problem .' + #13 + 'Error : ' + E.Message);
end;
end;
end;
When I run this code, I get the error "sorry this is a problem . Error: List index out of bounds(2)"
After calling image1.Picture.Graphic.SaveToStream(gambar), set gambar.Position back to 0 before then calling zbiodata2.Params[0].LoadFromStream(gambar,ftBlob):
image1.Picture.Graphic.SaveToStream(gambar);
gambar.Position := 0; // <-- add this
zbiodata2.Params[0].LoadFromStream(gambar,ftBlob);
With that said, you are using zbiodata2 for two different operations at the same time - editing a new row that is being appended, and executing an SQL statement. Don't do that! Use separate components for each operation.
If the image is being saved into the same row that is being appended, don't bother executing a separate SQL INSERT statement at all. Save the image data directly into the row's gambar TField before then calling zbiodata2.Post():
procedure Tfbiodata.btnSaveClick(Sender: TObject);
var
gambar : TStream;
begin
if (edtnis.Text='') or (edtname.Text='') or (cmbjk.Text='') or (edtempat.Text='') or (edtgl.Text='') or (cmbtingkatan.Text='') then
begin
ShowMessage('Maaf !!! Data Anda Belum Lengkap ....');
Exit;
end;
try
convertobmp(openpicture.FileName);
zbiodata2.Open;
zbiodata2.Append;
try
zbiodata2.FieldByName('NIS').AsString := edtnis.Text;
zbiodata2.FieldByName('Nama_siswa').AsString := edtname.Text;
zbiodata2.FieldByName('Jenis_kelamin').AsString := cmbjk.Text;
zbiodata2.FieldByName('Tempat_lahir').AsString := edtempat.Text;
zbiodata2.FieldByName('Tanggal_lahir').AsString := edtgl.Text;
zbiodata2.FieldByName('Tingkatan').AsString := cmbtingkatan.Text;
zbiodata2.FieldByName('Hasil_indentifkasi').AsString := lblhasil.Caption;
zbiodata2.FieldByName('Metode_pembeaaran').AsString := memo1.Text;
if (image1.Picture.Graphic <> nil) and (not image1.Picture.Graphic.Empty) then
begin
gambar := TMemoryStream.Create;
try
image1.Picture.Graphic.SaveToStream(gambar);
gambar.Position := 0;
(zbiodata2.FieldByName('gambar') as TBlobField).LoadFromStream(gambar);
finally
gambar.Free;
end;
{
Alternatively:
gambar := zbiodata2.CreateBlobStream(zbiodata2.FieldByName('gambar'), bmWrite);
try
image1.Picture.Graphic.SaveToStream(gambar);
finally
gambar.Free;
end;
}
end;
zbiodata2.Post;
except
zbiodata2.Cancel;
raise;
end;
except
on E:Exception do
ShowMessage('sorry this a problem .' + #13 + 'Error : ' + E.Message);
end;
end;
If you are still having problems after that, you need to explain what is actually going wrong, what errors you are seeing, etc.
When I try to check the validity of a zip file an exception is raised that the process can not access the file because it is being used by another process, yet the code in Open1.Click opens the zip file with no problem. Is there something wrong in Valid1Click?
procedure TForm1.Valid1Click(Sender: TObject);
{ Is the zip file valid. }
var
iZipFile: TZipFile;
iZipFilename: string;
iValid: Boolean;
begin
Screen.Cursor := crHourGlass;
try
{ Create the TZipFile Class }
iZipFile := TZipFile.Create;
try
if FileExists(ZipFilename1.Text) then
begin
iZipFilename := ZipFilename1.Text;
{ Open zip file for reading }
iZipFile.Open(iZipFilename, zmRead);
iValid := iZipFile.IsValid(iZipFilename);
if iValid then
MessageBox(0, 'The zip file is valid.', 'Check Zip File',
MB_ICONINFORMATION or MB_OK)
else
MessageBox(0, 'The zip file is NOT valid.', 'Check Zip File',
MB_ICONWARNING or MB_OK);
end
else
begin
MessageBox(0, 'The zip file does not exist.', 'Warning',
MB_ICONWARNING or MB_OK);
end;
{ Close the zip file }
iZipFile.Close;
finally
iZipFile.Free;
end;
finally
Screen.Cursor := crDefault;
end;
end;
procedure TForm1.Open1Click(Sender: TObject);
{ Open zip file. }
var
i: integer;
iZipFile: TZipFile;
iFilename: string;
iDateTime: TDateTime;
iCompressedSize: cardinal;
iUnCompressedSize: cardinal;
iCRC32: cardinal;
iCompressionMethod: word;
iFileComment: string;
iListItem: TlistItem;
begin
if OpenDialog1.Execute then
begin
if FileExists(OpenDialog1.FileName) then
begin
iZipFile := TZipFile.Create;
try
ListView1.Items.Clear;
ZipFilename1.Text := OpenDialog1.FileName;
try
iZipFile.Open(ZipFilename1.Text, zmReadWrite);
for i := 0 to iZipFile.FileCount - 1 do
begin
iFilename := iZipFile.FileNames[i];
iListItem := ListView1.Items.Add;
iListItem.Caption := iFilename;
iDateTime := FileDateToDateTime
(iZipFile.FileInfo[i].ModifiedDateTime);
iListItem.SubItems.Add(DateTimeToStr(iDateTime)); { 0 }
iCompressedSize := iZipFile.FileInfo[i].CompressedSize;
iListItem.SubItems.Add(FormatByteSize(iCompressedSize)); { 1 }
iUnCompressedSize := iZipFile.FileInfo[i].UncompressedSize;
iListItem.SubItems.Add(FormatByteSize(iUnCompressedSize)); { 2 }
iCRC32 := iZipFile.FileInfo[i].CRC32;
iListItem.SubItems.Add(IntToStr(iCRC32)); { 3 }
iCompressionMethod := iZipFile.FileInfo[i].CompressionMethod;
iListItem.SubItems.Add
(ZipCompressionToStr(iCompressionMethod)); { 4 }
iFileComment := iZipFile.Comment;
iListItem.SubItems.Add(iFileComment); { 5 }
end;
iZipFile.Close;
except
on E: Exception do
begin
ShowMessage(E.ClassName + #10#13 + E.Message);
end;
end;
finally
iZipFile.Free;
end;
end;
end;
You have these lines the wrong way round:
iZipFile.Open(iZipFilename, zmRead);
iValid := iZipFile.IsValid(iZipFilename);
The first line locks the file, and so the second line fails. You will have to call IsValid before calling Open.
Having said that, since you use zmRead, it should be possible for the call to IsValid to open the file again because the call to Open used fmOpenRead. So I suspect that there may be a bug in the ZIP file code, or the file stream code, in the version of Delphi that you are using. All the same, calling IsValid before Open is sure to work.
In fact, IsValid is a class method. You should call it like this:
iValid := TZipFile.IsValid(iZipFilename);
It comes to the same thing in the end, but it makes it clear to the reader of the code that the method call does not rely on the state of an instance.
In fact I personally would simply do away with the call to IsValid and go straight to calling Open. If that fails, I believe that a meaningful error message will be raised.
Update
Looks like you don't want to open the file at all, and just want to check its validity. In which case, you don't need an instance, you don't call the constructor, and you just use a single call to TZipFile.IsValid.
procedure TForm1.Valid1Click(Sender: TObject);
begin
Screen.Cursor := crHourGlass;
try
if FileExists(ZipFilename1.Text) then
begin
if TZipFile.IsValid(ZipFilename1.Text) then
...
finally
Screen.Cursor := crDefault;
end;
end;
As David Heffernan stated initially : it should be possible to use isValid after TZipFile::Open(filename, mode), since one would expect opening a file read only would not block it for others to read.
When using the Open-method based on a fileNAME (another one exists for reading f from a TFileStream), it internally creates a fileStream, and while it does specify fmOpenRead, it does not set a share mode on opening this stream.
See this blog post for an example on how this can be avoided by first creating a TFileStream yourself in which you specify the share mode explicitly :
https://www.digon.be/community/blog/TZipFile-problem-accessing-open-files-even-with-TZipMode-zmRead
i'm having touble using SHFileOperation do Copy and delete *.mb and *.db files
the CopyFiles code works great, copy all files and create the folder if needed but when i call DeleteFiles code something strange happens, all files in 'bkp' folder are deleted, but not the folder.
when i try to access the folder it say's "Access denied", after i close my application, folder get deleted ok.
here my procedure :
procedure TForm1.Button1Click(Sender: TObject);
var
shFOS : TShFileOpStruct;
FileNameTemp: string;
sr: TSearchRec;
begin
try
shFOS.Wnd := Application.MainForm.Handle;
shFOS.wFunc := FO_COPY;
shFOS.pFrom := PChar(DBEdit4.text+'\*.db' + #0);
shFOS.pTo := PChar(ExtractFilePath(ParamStr(0))+'bkp'+ #0);
shFOS.fFlags := FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
SHFileOperation(shFOS);
shFOS.Wnd := Application.MainForm.Handle;
shFOS.wFunc := FO_COPY;
shFOS.pFrom := PChar(DBEdit4.text+'\*.mb' + #0);
shFOS.pTo := PChar(ExtractFilePath(ParamStr(0))+'bkp'+ #0);
shFOS.fFlags := FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
SHFileOperation(shFOS);
finally
application.ProcessMessages;
//zip copied files
FilenameTemp:=ExtractFilePath(ParamStr(0))+FormatDateTime('dd-mm-yyyy-hh-nn-zzz',now)+'.zip';
ZipForge1.FileName := FilenameTemp;
ZipForge1.OpenArchive(fmCreate);
ZipForge1.BaseDir := ExtractFilePath(ParamStr(0))+'bkp';
ZipForge1.AddFiles('*.*');
ZipForge1.CloseArchive();
end;
// check if any files were copied in order to create the zip file and upload it
// if i skip the FindFirst code works greate
if (FindFirst(ExtractFilePath(ParamStr(0))+'bkp\*.db',faAnyFile,sr)=0) or (FindFirst(ExtractFilePath(ParamStr(0))+'bkp\*.mb',faAnyFile,sr)=0) then
begin
idftp1.Username:=user.Text;
idftp1.Password:=pw.Text;
idftp1.Port:=21;
idFTP1.Passive := false;
try
idftp1.Connect;
except
on E : Exception do
begin
Show;
if (Pos(LowerCase('user cannot'), LowerCase(E.Message)) > 0) and (Pos(LowerCase('log in.'), LowerCase(E.Message)) > 0) then
Application.MessageBox('USUÁRIO OU SENHA INVÁLIDO',Pchar(appCaption),mb_iconError+mb_ok)
else if (Pos(LowerCase('socket error'), LowerCase(E.Message)) > 0) and (Pos(LowerCase('host not found.'), LowerCase(E.Message)) > 0) then
Application.MessageBox('FALHA NA CONEXÃO, VERIFIQUE SUA INTERNET',Pchar(appCaption),mb_iconError+mb_ok)
else if e.Message<>'' then
begin
Application.MessageBox(Pchar('ERRO DESCONHECIDO, FAVOR ENTRAR EM CONTATO COM NOSSO SUPORTE TÉCNICO'
+#13+#10
+#13+#10+'INFORME O SEGUINTE ERRO :'
+#13+#10
+#13+#10+e.Message),Pchar(appCaption),mb_iconError+mb_ok);
end;
exit;
end;
end;
try
idftp1.Put(FileNameTemp,ExtractFileName(FilenameTemp));
finally
//DeleteFiles
idftp1.Disconnect;
ZeroMemory(#shFOS, SizeOf(TShFileOpStruct));
shFOS.Wnd := Application.MainForm.Handle;
shFOS.wFunc := FO_DELETE;
shFOS.pFrom := PChar(ExtractFilePath(ParamStr(0))+'bkp'+#0);
shFOS.fFlags := FOF_NOCONFIRMATION;
SHFileOperation(shFOS); // The error occurs here, files in bkp folder are deleted
//but the folder still exists, and everytime i try to make another backup or remove the
//folder manually through windows the error os "Access denied"
end;
end;
end;
The obvious problem in the updated code is that you call FindFirst, but do not match those with calls to FindClose. Quite possibly the search handles that you fail to close are what blocks the delete operation from completing.