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
Related
Var
MyFile : Textfile;
shine: String;
Begin
AssignFile(myfile, 'Username.txt');
Reset ( myFile);
While not EOF(myFile) do
If sLine = edtEnterUser.Text then
Begin
ShowMessage ('Username already exists')
Begin
ReadLn(myFile,sLine);
end
else
Append(myFile);
CloseFile(myFile);
TStringList(Classes) is simpler
var
sl: TStringList;
begin
sl := TStringList.Create;
try
sl.LoadFromFile('Username.txt');
if sl.IndexOf(edtEnterUser.Text) > -1 then
ShowMessage ('Username already exists');
finally
sl.Free;
end;
end;
I just wanted to add some explanation for OP's questions regarding #Para's answer.
You can create a TStringList class, make it load any file with encoding if required and manipulate it then save it again. Explination:
var
sl: TStringList;
begin
sl := TStringList.Create; // Create the stringlist
try // Run the code inside a try block so that if an exception gets thrown it will still free the stringlist to prevent a memory leak.
sl.LoadFromFile('Username.txt', TEncoding.UTF8); // Load the text inside the file.
if sl.IndexOf(edtEnterUser.Text) > -1 then // If the index is greater than -1 then it exists however if it's -1 then it doesnt exist
ShowMessage ('Username already exists')
else
begin
sl.add(edtEnterUser.Text); // If it doesnt exist then add it.
sl.SaveToFile('Username.txt', TEncoding.UTF8); // save to the file.
end;
finally
sl.Free; // Lastly free the stringlist from memory. This code will run regardless if there are errors.
end;
end;
The code you have shown does not compile, for several reasons.
In any case, to do what you want, simply call ReadLn() in a loop, comparing what was read, and if you detect the string you are looking for then set a Boolean and exit the loop. Then check the Boolean after the loop is finished. For example:
var
MyFile: TextFile;
sUser, sLine: String;
bFound: Boolean;
begin
sUser := edtEnterUser.Text;
AssignFile(MyFile, 'Username.txt');
Reset(MyFile);
bFound := False;
while not EOF(MyFile) do
begin
ReadLn(MyFile, sLine);
if sLine = sUser then
begin
bFound := True;
Break;
end;
end;
if bFound then begin
ShowMessage('Username already exists');
end else
begin
CloseFile(MyFile);
Append(MyFile);
WriteLn(MyFile, sUser);
end;
CloseFile(MyFile);
end;
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 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"?
This program raises an I/O 104 error on EoF when first entering the while loop.
The purpose of the program is to look up if a username is already taken. The existing usernames are stored in a text file.
procedure TForm1.btnRegisterClick(Sender: TObject);
begin
sCUser := edtUserName.Text;
AssignFile(tNames, 'Names.txt');
begin
try
Reset(tNames);
except
ShowMessage('File not found');
Exit;
end;
end;
rewrite(tNames);
while not EoF(tNames) do // I get a I/O 104 Error here `
begin
Readln(tNames, sLine);
iPosComme := Pos(',', sLine);
sUser := Copy(sLine, 1, iPosComme - 1);
Delete(sLine, 1, iPosComme - 1);
if sCUser = sUser then begin
ShowMessage('Username taken');
end
else
begin
rewrite(tNames);
Writeln(tNames, sCUser + ',' + '0');
CloseFile(tNames);
end;
end;
end;
Remove the call to Rewrite()before Eof(). Even if you were not getting an IO error, your code would still fail because Rewrite() closes the file you opened with Reset() and then it creates a new bank file, so Eof() would always be True.
Update: error 104 is file not open for input, which means Reset() is not opening the file but is not raising an exception (which sounds like an RTL bug if Eof() is raising an exception, indicating that {I+} is active).
In any case, using AssignFile() and related routines is the old way to do file I/O. You should use newer techniques, like FileOpen() with FileRead(), TFileStream with TStreamReader, TStringList, etc...
Update: your loop logic is wrong. You are comparing only the first line. If it does not match the user, you are wiping out the file, writing the user to a new file, closing the file, and then continuing the loop. EoF() will then fail at that point. You need to rewrite your loop to the following:
procedure TForm1.btnRegisterClick(Sender: TObject
var
SCUser, sUser: String;
tNames: TextFile;
iPosComme: Integer;
Found: Boolean;
begin
sCUser := edtUserName.Text;
AssignFile(tNames,'Names.txt');
try
Reset(tNames);
except
ShowMessage('File not found');
Exit;
end;
try
Found := False;
while not EoF(tNames) do
begin
Readln(tNames,sLine);
iPosComme := Pos(',', sLine);
sUser := Copy(sLine ,1,iPosComme -1);
if sCUser = sUser then
begin
ShowMessage('Username taken') ;
Found := True;
Break;
end;
end;
if not Found then
Writeln(tNames,sCUser + ',0');
finally
CloseFile(tNames);
end;
end;
For the sake of completeness, this Version works for me, but it is hard to guess what the code is intended to do. Especially the while loop seems a bit displaced, since the file will contain exactly one line after the rewrite-case has ben hit once.
program wtf;
{$APPTYPE CONSOLE}
{$I+}
uses
SysUtils;
procedure Sample( sCUser : string);
var sUser, sLine : string;
iPosComme : Integer;
tnames : textfile;
begin
AssignFile(tNames,'Names.txt');
try
Reset(tNames);
except
Writeln('File not found');
Exit;
end;
while not EoF(tNames) do
begin
Readln(tNames,sLine);
iPosComme := Pos(',', sLine);
sUser := Copy(sLine ,1,iPosComme -1);
Delete( sLine,1, iPosComme -1);
if sCuser = sUser then begin
Writeln('Username taken') ;
end
else begin
Rewrite(tNames);
Writeln(tNames,sCUser + ',' + '0');
CloseFile(tNames);
Break; // file has been overwritten and closed
end;
end;
end;
begin
try
Sample('foobar');
except
on E: Exception do Writeln(E.ClassName, ': ', E.Message);
end;
end.
I wrote a version of this method that uses the newer TStreamReader and TStreamWriter classes.
This won't work with Delphi 7 of course, it's just to show how this could be done in newer versions of Delphi.
The code was heavily inspired by Remys answer.
procedure TForm1.btnRegisterClick(Sender: TObject);
var
Stream: TStream;
Reader: TStreamReader;
Writer: TStreamWriter;
Columns: TStringList;
UserName: string;
Found: Boolean;
FileName: string;
Encoding: TEncoding;
begin
FileName := ExpandFileName('Names.txt'); // An absolute path would be even better
UserName := edtUsername.Text;
Found := False;
Encoding := TEncoding.Default; // or another encoding, e.g. TEncoding.Unicode for Unicode
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
Reader := TStreamReader.Create(Stream, Encoding);
try
Columns := TStringList.Create;
try
Columns.Delimiter := ',';
Columns.StrictDelimiter := True; // or False, depending on the file format
while not Reader.EndOfStream do
begin
Columns.DelimitedText := Reader.ReadLine;
if Columns.Count > 0 then
begin
if AnsiSameStr(Columns[0], UserName) then // or AnsiSameText if UserName is not case-sensitive
begin
ShowMessage('Username taken') ;
Found := True;
Break;
end;
end;
end;
finally
Columns.Free;
end;
finally
Reader.Free;
end;
finally
Stream.Free;
end;
if not Found then
begin
Writer := TStreamWriter.Create(FileName, True, Encoding);
try
// Warning: This will cause problems when the file does not end with a new line
Writer.WriteLine(UserName + ',0');
finally
Writer.Free;
end;
end;
end;
If performance and memory usage are not a concern:
procedure TForm1.btnRegisterClick(Sender: TObject);
var
Rows: TStringList;
Columns: TStringList;
UserName: string;
Found: Boolean;
FileName: string;
Encoding: TEncoding;
Row: string;
begin
FileName := ExpandFileName('Names.txt'); // An absolute path would be even better
UserName := edtUsername.Text;
Found := False;
Encoding := TEncoding.Default; // or another encoding, e.g. TEncoding.Unicode for Unicode
Rows := TStringList.Create;
try
Rows.LoadFromFile(FileName, Encoding);
Columns := TStringList.Create;
try
Columns.Delimiter := ',';
Columns.StrictDelimiter := True; // or False, depending on the file format
for Row in Rows do
begin
Columns.DelimitedText := Row;
if Columns.Count > 0 then
begin
if AnsiSameStr(Columns[0], UserName) then // or AnsiSameText if UserName is not case-sensitive
begin
ShowMessage('Username taken') ;
Found := True;
Break;
end;
end;
end;
finally
Columns.Free;
end;
if not Found then
begin
Rows.Add(UserName + ',0');
Rows.SaveToFile(FileName, Encoding);
end;
finally
Rows.Free;
end;
end;
This solution can be adapted to Delphi 7 by removing the Encoding variable.
If it's part of a bigger database it should be stored in a real database management system rather than a text file.
I have a function like this, that I would like to refactor
function Myfunction(sUrl, sFile: String) : Boolean;
var
GetData : TFileStream;
begin
Result := False;
//if the line below fails, I get an unhandled exception
GetData := TFileStream.Create(sFile, fmOpenWrite or fmCreate);
try
try
IdHTTP.Get(sUrl, GetData);
Result := (IdHTTP.ResponseCode = 200);
except
on E: Exception do begin
MessageBox(0, PChar(E.message), 'Niðurhala skrá', MB_ICONERROR or MB_OK);
end;
end;
finally
GetData.Free;
end;
end;
Procedure SomeOtherCode;
Begin
//How can I best defend against the unhandled exception above
//unless the call to the function is packed in a try .. except block
//the code jumps skips the if statement an goes to next
//exception block on the stack
if MyFunction('http://domain.com/file.html', 'c:\folder\file.html') then
ShowMessage('Got the file')
else
ShowMessage('Error !');
End
end;
Question:
Please refer to the comment within the procedure SomeOtherCode above.
Best Regards
Just wrap the code where you want to trap exceptions in a try..except block:
function MyFunction(...): Boolean;
var
Stream: TFileStream;
begin
Result := False;
try
Stream := TFileStream.Create(...);
try
// more code
Result := ...
finally
Stream.Free;
end;
except
// handle exception
end
end;
The whole point about exception handling is two-fold:
finally is for resource cleanup; you see this often in business logic
except is for reacting on specific exception (and getting rid of state logic through function results and intermediate variables); you hardly see it in business logic
In your case:
Myfunction should not return a Boolean, not contain an except block, and not perform a MessageBox but just let the exceptions propagate.
SomeOtherCode should contain the except block and tell the user what went wrong.
Example:
procedure Myfunction(sUrl, sFile: String);
var
GetData: TFileStream;
begin
Result := False;
//if the line below fails, I get an unhandled exception
GetData := TFileStream.Create(sFile, fmOpenWrite or fmCreate);
try
IdHTTP.Get(sUrl, GetData);
if (IdHTTP.ResponseCode <> 200) <> then
raise Exception.CreateFmt('Download of %s failed, return code %d', [sURl, IdHTTP.ResponseCode]);
finally
GetData.Free;
end;
end;
procedure SomeOtherCode:
begin
try
MyFunction('http://domain.com/file.html', 'c:\folder\file.html');
except
on E: Exception do begin
MessageBox(0, PChar(E.message), 'Niðurhala skrá', MB_ICONERROR or MB_OK);
end;
end;
end;
Now the code is much cleaner:
no more UI in your business logic
one place where your except is being handled
all failures are handled equally (cannot create file, download failure)
Good luck with this.
--jeroen
If you want your function to show messages to the user and return false on any failure, code it as follows:
function Myfunction(sUrl, sFile: String) : Boolean;
var
GetData : TFileStream;
begin
Result := False;
try
//if the line below fails, I get an unhandled exception
GetData := TFileStream.Create(sFile, fmOpenWrite or fmCreate);
try
try
IdHTTP.Get(sUrl, GetData);
Result := (IdHTTP.ResponseCode = 200);
except
on E: Exception do begin
MessageBox(0, PChar(E.message), 'Niðurhala skrá', MB_ICONERROR or MB_OK);
end;
end;
finally
GetData.Free;
end;
except
// you can handle specific exceptions (like file creation errors) or any exception here
end;
end;
Warning
IMHO this design is mixing business logic (such as get a resource/file from the Internet and save it to a file) and user interface logic (such as showing messages to the user in case of errors).
In general, is a better approach to separate business from UI logic, because your code is reusable.
For example you might want to re-factor as this:
function DownloadToAFile(const sUrl, sFile: string): boolean;
var
GetData : TFileStream;
begin
GetData := TFileStream.Create(sFile, fmOpenWrite or fmCreate);
try
IdHTTP.Get(sUrl, GetData);
Result := (IdHTTP.ResponseCode = 200);
finally
GetData.Free;
end;
end;
function UIDownloadToAFile(const sUrl, sFile: string): boolean;
begin
try
Result := DownloadToAFile(sURL, sFile);
except
on E: EIDException do //IndyError
MessageBox(0, PChar(E.message), 'Internet Error', MB_ICONERROR or MB_OK);
on E: EFileCreateError do //just can't remember the extact class name for this error
MessageBox(0, PChar(E.message), 'File create Error', MB_ICONERROR or MB_OK);
end;
end;
procedure SomeOtherCode:
begin
if UIDownloadToAFile('http://domain.com/file.html', 'c:\folder\file.html') then
ShowMessage('Got the file')
else
ShowMessage('Error !');
end;
Tomorrow, if you're writing a service, or a DataSnap module, you're free to use the DownloadToAFile or maybe to write a new ServiceDownloadToAFile wich in turns writes errors to a log or windows events, or maybe send a email notifying the HostAdmin about it.
One solution which is quite popular is to avoid 'success' or 'failure' return values completely. Instead of a function, use a procedure and handle failures using exceptions instead:
procedure Download(sUrl, sFile: String);
and then
try
Download ('http://domain.com/file.html', 'c:\folder\file.html');
ShowMessage('Got the file')
except
on E:Exxx do
begin
// handle exception
ShowMessage('Error !');
end
end;
This has also the effect that nobody can invoke the function and silently ignore the return value.
For some reason most people misuse except-finally combination. Correct sequence is
try
// allocate resource here
try
finally
// free resource here
end;
except
// handle exception here
end;
This lets you catch exceptions in constructor and destructor.
You should use only one try and get in this your all function code.